aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog89
-rw-r--r--lisp/align.el409
-rw-r--r--lisp/calc/calc-keypd.el17
-rw-r--r--lisp/calendar/timeclock.el118
-rw-r--r--lisp/emacs-lisp/pp.el6
-rw-r--r--lisp/erc/ChangeLog31
-rw-r--r--lisp/erc/erc-button.el31
-rw-r--r--lisp/erc/erc-list.el15
-rw-r--r--lisp/erc/erc-notify.el54
-rw-r--r--lisp/erc/erc-track.el35
-rw-r--r--lisp/erc/erc.el597
-rw-r--r--lisp/files.el16
-rw-r--r--lisp/minibuffer.el3
-rw-r--r--lisp/progmodes/cc-awk.el81
-rw-r--r--lisp/progmodes/cc-engine.el15
-rw-r--r--lisp/progmodes/cc-langs.el3
-rw-r--r--lisp/progmodes/sh-script.el59
-rw-r--r--lisp/rfn-eshadow.el10
-rw-r--r--lisp/textmodes/fill.el2
-rw-r--r--lisp/window.el5
20 files changed, 866 insertions, 730 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 28431e9a08d..cbeea784579 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,92 @@
12013-08-25 Alan Mackenzie <acm@muc.de>
2
3 Parse C++ inher-intro when there's a template split over 2 lines.
4
5 * progmodes/cc-engine.el (c-guess-basic-syntax CASE 5C): Code more
6 rigorously the search for "class" etc. followed by ":".
7
8 * progmodes/cc-langs.el (c-opt-<>-sexp-key): Make the value for
9 random languages a regexp which never matches rather than nil.
10
11 Handle "/"s more accurately in test for virtual semicolons (AWK Mode).
12
13 * progmodes/cc-awk.el (c-awk-one-line-possibly-open-string-re)
14 (c-awk-regexp-one-line-possibly-open-char-list-re)
15 (c-awk-one-line-possibly-open-regexp-re)
16 (c-awk-one-line-non-syn-ws*-re): Remove.
17 (c-awk-possibly-open-string-re, c-awk-non-/-syn-ws*-re)
18 (c-awk-space*-/-re, c-awk-space*-regexp-/-re)
19 (c-awk-space*-unclosed-regexp-/-re): New constants.
20 (c-awk-at-vsemi-p): Reformulate better to recognize "/"s which
21 aren't regexp delimiters.
22
23 * progmodes/cc-engine.el (c-crosses-statement-barrier-p): Add in
24 handling for a rare situation in AWK Mode involving unterminated
25 strings/regexps.
26
272013-08-23 Glenn Morris <rgm@gnu.org>
28
29 * files.el (auto-mode-alist): Use sh-mode for .bash_history.
30
31 * files.el (interpreter-mode-alist): Use tcl-mode for expect scripts.
32
33 * files.el (create-file-buffer): If the result would begin with
34 spaces, prepend a "|" instead of removing them. (Bug#15162)
35
362013-08-23 Stefan Monnier <monnier@iro.umontreal.ca>
37
38 * textmodes/fill.el (fill-match-adaptive-prefix): Don't throw away
39 text-properties (bug#15155).
40
41 * calc/calc-keypd.el (calc-keypad-execute): `x-flush-mouse-queue' doesn't
42 exist any more.
43 (calc-keypad-redraw): Remove unused var `pad'.
44 (calc-keypad-press): Remove unused var `menu'.
45
462013-08-23 Martin Rudalics <rudalics@gmx.at>
47
48 * window.el (display-buffer-pop-up-frame):
49 Call pop-up-frame-function with BUFFER current so `make-frame' will
50 use it as the new frame's buffer (Bug#15133).
51
522013-08-22 Stefan Monnier <monnier@iro.umontreal.ca>
53
54 * calendar/timeclock.el: Minor cleanups.
55 (timeclock-ask-before-exiting, timeclock-use-display-time):
56 Use `symbol'.
57 (timeclock-modeline-display): Define as alias before the
58 actual definition.
59 (timeclock-mode-line-display): Use define-minor-mode.
60 (timeclock-day-list-template): Make it a function, add an argument.
61 (timeclock-day-list-required, timeclock-day-list-length)
62 (timeclock-day-list-debt, timeclock-day-list-span)
63 (timeclock-day-list-break): Adjust calls accordingly.
64
652013-08-21 Stefan Monnier <monnier@iro.umontreal.ca>
66
67 * emacs-lisp/pp.el (pp-eval-expression, pp-macroexpand-expression):
68 Use read--expression so that completion works again.
69
702013-08-21 Sam Steingold <sds@gnu.org>
71
72 Add rudimentary inferior shell interaction
73 * progmodes/sh-script.el (sh-shell-process): New buffer-local variable.
74 (sh-set-shell): Reset it.
75 (sh-show-shell, sh-cd-here, sh-send-line-or-region-and-step):
76 New commands (bound to C-c C-z, C-c C-d, and C-c C-n).
77
782013-08-20 Stefan Monnier <monnier@iro.umontreal.ca>
79
80 * align.el: Use lexical-binding.
81 (align-region): Simplify accordingly.
82
832013-08-20 Michael Albinus <michael.albinus@gmx.de>
84
85 * minibuffer.el (completion--sifn-requote): Bind `non-essential'.
86
87 * rfn-eshadow.el (rfn-eshadow-update-overlay): Move binding of
88 `non-essential' up.
89
12013-08-17 Michael Albinus <michael.albinus@gmx.de> 902013-08-17 Michael Albinus <michael.albinus@gmx.de>
2 91
3 * net/tramp.el: 92 * net/tramp.el:
diff --git a/lisp/align.el b/lisp/align.el
index 3d2ca192245..6f55ac9faf1 100644
--- a/lisp/align.el
+++ b/lisp/align.el
@@ -1,4 +1,4 @@
1;;; align.el --- align text to a specific column, by regexp 1;;; align.el --- align text to a specific column, by regexp -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 1999-2013 Free Software Foundation, Inc. 3;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
4 4
@@ -1325,7 +1325,7 @@ aligner would have dealt with are."
1325 (unless (or (and modes (not (memq major-mode 1325 (unless (or (and modes (not (memq major-mode
1326 (eval (cdr modes))))) 1326 (eval (cdr modes)))))
1327 (and run-if (not (funcall (cdr run-if))))) 1327 (and run-if (not (funcall (cdr run-if)))))
1328 (let* ((current-case-fold case-fold-search) 1328 (let* ((case-fold-search case-fold-search)
1329 (case-fold (assq 'case-fold rule)) 1329 (case-fold (assq 'case-fold rule))
1330 (regexp (cdr (assq 'regexp rule))) 1330 (regexp (cdr (assq 'regexp rule)))
1331 (regfunc (and (functionp regexp) regexp)) 1331 (regfunc (and (functionp regexp) regexp))
@@ -1403,215 +1403,202 @@ aligner would have dealt with are."
1403 ;; reports back that the region is ok, then align it. 1403 ;; reports back that the region is ok, then align it.
1404 (when (or (not func) 1404 (when (or (not func)
1405 (funcall func beg end rule)) 1405 (funcall func beg end rule))
1406 (unwind-protect 1406 (let (rule-beg exclude-areas)
1407 (let (rule-beg exclude-areas) 1407 ;; determine first of all where the exclusions
1408 ;; determine first of all where the exclusions 1408 ;; lie in this region
1409 ;; lie in this region 1409 (when exclude-rules
1410 (when exclude-rules 1410 (align-region
1411 ;; guard against a problem with recursion and 1411 beg end 'entire
1412 ;; dynamic binding vs. lexical binding, since 1412 exclude-rules nil
1413 ;; the call to `align-region' below will 1413 (lambda (b e mode)
1414 ;; re-enter this function, and rebind 1414 (or (and mode (listp mode))
1415 ;; `exclude-areas' 1415 (setq exclude-areas
1416 (set (setq exclude-areas 1416 (cons (cons b e)
1417 (make-symbol "align-exclude-areas")) 1417 exclude-areas)))))
1418 nil) 1418 (setq exclude-areas
1419 (align-region 1419 (nreverse
1420 beg end 'entire 1420 (sort exclude-areas #'car-less-than-car))))
1421 exclude-rules nil 1421
1422 `(lambda (b e mode) 1422 ;; set `case-fold-search' according to the
1423 (or (and mode (listp mode)) 1423 ;; (optional) `case-fold' property
1424 (set (quote ,exclude-areas) 1424 (and case-fold
1425 (cons (cons b e) 1425 (setq case-fold-search (cdr case-fold)))
1426 ,exclude-areas))))) 1426
1427 (setq exclude-areas 1427 ;; while we can find the rule in the alignment
1428 (sort (symbol-value exclude-areas) 1428 ;; region..
1429 (function 1429 (while (and (< (point) end-mark)
1430 (lambda (l r) 1430 (setq search-start (point))
1431 (>= (car l) (car r))))))) 1431 (if regfunc
1432 1432 (funcall regfunc end-mark nil)
1433 ;; set `case-fold-search' according to the 1433 (re-search-forward regexp
1434 ;; (optional) `case-fold' property 1434 end-mark t)))
1435 (and case-fold 1435
1436 (setq case-fold-search (cdr case-fold))) 1436 ;; give the user some indication of where we
1437 1437 ;; are, if it's a very large region being
1438 ;; while we can find the rule in the alignment 1438 ;; aligned
1439 ;; region.. 1439 (if report
1440 (while (and (< (point) end-mark) 1440 (let ((symbol (car rule)))
1441 (setq search-start (point)) 1441 (if (and symbol (symbolp symbol))
1442 (if regfunc 1442 (message
1443 (funcall regfunc end-mark nil) 1443 "Aligning `%s' (rule %d of %d) %d%%..."
1444 (re-search-forward regexp 1444 (symbol-name symbol) rule-index rule-count
1445 end-mark t))) 1445 (/ (* (- (point) real-beg) 100)
1446 1446 (- end-mark real-beg)))
1447 ;; give the user some indication of where we 1447 (message
1448 ;; are, if it's a very large region being 1448 "Aligning %d%%..."
1449 ;; aligned 1449 (/ (* (- (point) real-beg) 100)
1450 (if report 1450 (- end-mark real-beg))))))
1451 (let ((symbol (car rule))) 1451
1452 (if (and symbol (symbolp symbol)) 1452 ;; if the search ended us on the beginning of
1453 (message 1453 ;; the next line, move back to the end of the
1454 "Aligning `%s' (rule %d of %d) %d%%..." 1454 ;; previous line.
1455 (symbol-name symbol) rule-index rule-count 1455 (if (and (bolp) (> (point) search-start))
1456 (/ (* (- (point) real-beg) 100) 1456 (forward-char -1))
1457 (- end-mark real-beg))) 1457
1458 (message 1458 ;; lookup the `group' attribute the first time
1459 "Aligning %d%%..." 1459 ;; that we need it
1460 (/ (* (- (point) real-beg) 100) 1460 (unless group-c
1461 (- end-mark real-beg)))))) 1461 (setq groups (or (cdr (assq 'group rule)) 1))
1462 1462 (unless (listp groups)
1463 ;; if the search ended us on the beginning of 1463 (setq groups (list groups)))
1464 ;; the next line, move back to the end of the 1464 (setq first (car groups)))
1465 ;; previous line. 1465
1466 (if (and (bolp) (> (point) search-start)) 1466 (unless spacing-c
1467 (forward-char -1)) 1467 (setq spacing (cdr (assq 'spacing rule))
1468 1468 spacing-c t))
1469 ;; lookup the `group' attribute the first time 1469
1470 ;; that we need it 1470 (unless tab-stop-c
1471 (unless group-c 1471 (setq tab-stop
1472 (setq groups (or (cdr (assq 'group rule)) 1)) 1472 (let ((rule-ts (assq 'tab-stop rule)))
1473 (unless (listp groups) 1473 (cond (rule-ts
1474 (setq groups (list groups))) 1474 (cdr rule-ts))
1475 (setq first (car groups))) 1475 ((symbolp align-to-tab-stop)
1476 1476 (symbol-value align-to-tab-stop))
1477 (unless spacing-c 1477 (t
1478 (setq spacing (cdr (assq 'spacing rule)) 1478 align-to-tab-stop)))
1479 spacing-c t)) 1479 tab-stop-c t))
1480 1480
1481 (unless tab-stop-c 1481 ;; test whether we have found a match on the same
1482 (setq tab-stop 1482 ;; line as a previous match
1483 (let ((rule-ts (assq 'tab-stop rule))) 1483 (when (> (point) eol)
1484 (cond (rule-ts 1484 (setq same nil)
1485 (cdr rule-ts)) 1485 (align--set-marker eol (line-end-position)))
1486 ((symbolp align-to-tab-stop) 1486
1487 (symbol-value align-to-tab-stop)) 1487 ;; lookup the `repeat' attribute the first time
1488 (t 1488 (or repeat-c
1489 align-to-tab-stop))) 1489 (setq repeat (cdr (assq 'repeat rule))
1490 tab-stop-c t)) 1490 repeat-c t))
1491 1491
1492 ;; test whether we have found a match on the same 1492 ;; lookup the `valid' attribute the first time
1493 ;; line as a previous match 1493 (or valid-c
1494 (when (> (point) eol) 1494 (setq valid (assq 'valid rule)
1495 (setq same nil) 1495 valid-c t))
1496 (align--set-marker eol (line-end-position))) 1496
1497 1497 ;; remember the beginning position of this rule
1498 ;; lookup the `repeat' attribute the first time 1498 ;; match, and save the match-data, since either
1499 (or repeat-c 1499 ;; the `valid' form, or the code that searches for
1500 (setq repeat (cdr (assq 'repeat rule)) 1500 ;; section separation, might alter it
1501 repeat-c t)) 1501 (setq rule-beg (match-beginning first)
1502 1502 save-match-data (match-data))
1503 ;; lookup the `valid' attribute the first time 1503
1504 (or valid-c 1504 (or rule-beg
1505 (setq valid (assq 'valid rule) 1505 (error "No match for subexpression %s" first))
1506 valid-c t)) 1506
1507 1507 ;; unless the `valid' attribute is set, and tells
1508 ;; remember the beginning position of this rule 1508 ;; us that the rule is not valid at this point in
1509 ;; match, and save the match-data, since either 1509 ;; the code..
1510 ;; the `valid' form, or the code that searches for 1510 (unless (and valid (not (funcall (cdr valid))))
1511 ;; section separation, might alter it 1511
1512 (setq rule-beg (match-beginning first) 1512 ;; look to see if this match begins a new
1513 save-match-data (match-data)) 1513 ;; section. If so, we should align what we've
1514 1514 ;; collected so far, and then begin collecting
1515 (or rule-beg 1515 ;; anew for the next alignment section
1516 (error "No match for subexpression %s" first)) 1516 (when (and last-point
1517 1517 (align-new-section-p last-point rule-beg
1518 ;; unless the `valid' attribute is set, and tells 1518 thissep))
1519 ;; us that the rule is not valid at this point in 1519 (align-regions regions align-props rule func)
1520 ;; the code.. 1520 (setq regions nil)
1521 (unless (and valid (not (funcall (cdr valid)))) 1521 (setq align-props nil))
1522 1522 (align--set-marker last-point rule-beg t)
1523 ;; look to see if this match begins a new 1523
1524 ;; section. If so, we should align what we've 1524 ;; restore the match data
1525 ;; collected so far, and then begin collecting 1525 (set-match-data save-match-data)
1526 ;; anew for the next alignment section 1526
1527 (when (and last-point 1527 ;; check whether the region to be aligned
1528 (align-new-section-p last-point rule-beg 1528 ;; straddles an exclusion area
1529 thissep)) 1529 (let ((excls exclude-areas))
1530 (align-regions regions align-props rule func) 1530 (setq exclude-p nil)
1531 (setq regions nil) 1531 (while excls
1532 (setq align-props nil)) 1532 (if (and (< (match-beginning (car groups))
1533 (align--set-marker last-point rule-beg t) 1533 (cdar excls))
1534 1534 (> (match-end (car (last groups)))
1535 ;; restore the match data 1535 (caar excls)))
1536 (set-match-data save-match-data) 1536 (setq exclude-p t
1537 1537 excls nil)
1538 ;; check whether the region to be aligned 1538 (setq excls (cdr excls)))))
1539 ;; straddles an exclusion area 1539
1540 (let ((excls exclude-areas)) 1540 ;; go through the parenthesis groups
1541 (setq exclude-p nil) 1541 ;; matching whitespace to be contracted or
1542 (while excls 1542 ;; expanded (or possibly justified, if the
1543 (if (and (< (match-beginning (car groups)) 1543 ;; `justify' attribute was set)
1544 (cdar excls)) 1544 (unless exclude-p
1545 (> (match-end (car (last groups))) 1545 (dolist (g groups)
1546 (caar excls))) 1546 ;; We must use markers, since
1547 (setq exclude-p t 1547 ;; `align-areas' may modify the buffer.
1548 excls nil) 1548 ;; Avoid polluting the markers.
1549 (setq excls (cdr excls))))) 1549 (let* ((group-beg (copy-marker
1550 1550 (match-beginning g) t))
1551 ;; go through the parenthesis groups 1551 (group-end (copy-marker
1552 ;; matching whitespace to be contracted or 1552 (match-end g) t))
1553 ;; expanded (or possibly justified, if the 1553 (region (cons group-beg group-end))
1554 ;; `justify' attribute was set) 1554 (props (cons (if (listp spacing)
1555 (unless exclude-p 1555 (car spacing)
1556 (dolist (g groups) 1556 spacing)
1557 ;; We must use markers, since 1557 (if (listp tab-stop)
1558 ;; `align-areas' may modify the buffer. 1558 (car tab-stop)
1559 ;; Avoid polluting the markers. 1559 tab-stop))))
1560 (let* ((group-beg (copy-marker 1560 (push group-beg markers)
1561 (match-beginning g) t)) 1561 (push group-end markers)
1562 (group-end (copy-marker 1562 (setq index (if same (1+ index) 0))
1563 (match-end g) t)) 1563 (cond
1564 (region (cons group-beg group-end)) 1564 ((nth index regions)
1565 (props (cons (if (listp spacing) 1565 (setcar (nthcdr index regions)
1566 (car spacing) 1566 (cons region
1567 spacing) 1567 (nth index regions))))
1568 (if (listp tab-stop) 1568 (regions
1569 (car tab-stop) 1569 (nconc regions
1570 tab-stop)))) 1570 (list (list region)))
1571 (push group-beg markers) 1571 (nconc align-props (list props)))
1572 (push group-end markers) 1572 (t
1573 (setq index (if same (1+ index) 0)) 1573 (setq regions
1574 (cond 1574 (list (list region)))
1575 ((nth index regions) 1575 (setq align-props (list props)))))
1576 (setcar (nthcdr index regions) 1576 ;; If any further rule matches are found
1577 (cons region 1577 ;; before `eol', they are on the same
1578 (nth index regions)))) 1578 ;; line as this one; this can only
1579 (regions 1579 ;; happen if the `repeat' attribute is
1580 (nconc regions 1580 ;; non-nil.
1581 (list (list region))) 1581 (if (listp spacing)
1582 (nconc align-props (list props))) 1582 (setq spacing (cdr spacing)))
1583 (t 1583 (if (listp tab-stop)
1584 (setq regions 1584 (setq tab-stop (cdr tab-stop)))
1585 (list (list region))) 1585 (setq same t))
1586 (setq align-props (list props))))) 1586
1587 ;; If any further rule matches are found 1587 ;; if `repeat' has not been set, move to
1588 ;; before `eol', they are on the same 1588 ;; the next line; don't bother searching
1589 ;; line as this one; this can only 1589 ;; anymore on this one
1590 ;; happen if the `repeat' attribute is 1590 (if (and (not repeat) (not (bolp)))
1591 ;; non-nil. 1591 (forward-line))
1592 (if (listp spacing) 1592
1593 (setq spacing (cdr spacing))) 1593 ;; if the search did not change point,
1594 (if (listp tab-stop) 1594 ;; move forward to avoid an infinite loop
1595 (setq tab-stop (cdr tab-stop))) 1595 (if (= (point) search-start)
1596 (setq same t)) 1596 (forward-char)))))
1597 1597
1598 ;; if `repeat' has not been set, move to 1598 ;; when they are no more matches for this rule,
1599 ;; the next line; don't bother searching 1599 ;; align whatever was left over
1600 ;; anymore on this one 1600 (if regions
1601 (if (and (not repeat) (not (bolp))) 1601 (align-regions regions align-props rule func))))))))
1602 (forward-line))
1603
1604 ;; if the search did not change point,
1605 ;; move forward to avoid an infinite loop
1606 (if (= (point) search-start)
1607 (forward-char)))))
1608
1609 ;; when they are no more matches for this rule,
1610 ;; align whatever was left over
1611 (if regions
1612 (align-regions regions align-props rule func)))
1613
1614 (setq case-fold-search current-case-fold)))))))
1615 (setq rules (cdr rules) 1602 (setq rules (cdr rules)
1616 rule-index (1+ rule-index))) 1603 rule-index (1+ rule-index)))
1617 ;; This function can use a lot of temporary markers, so instead of 1604 ;; This function can use a lot of temporary markers, so instead of
diff --git a/lisp/calc/calc-keypd.el b/lisp/calc/calc-keypd.el
index a720f12a573..bd24bf7f15d 100644
--- a/lisp/calc/calc-keypd.el
+++ b/lisp/calc/calc-keypd.el
@@ -349,8 +349,7 @@
349 (if (> (length (car key)) cwid) 349 (if (> (length (car key)) cwid)
350 (substring (car key) 0 cwid) 350 (substring (car key) 0 cwid)
351 (car key)))) 351 (car key))))
352 (wid (length name)) 352 (wid (length name)))
353 (pad (- cwid (/ wid 2))))
354 (insert (make-string (/ (- cwid wid) 2) 32) 353 (insert (make-string (/ (- cwid wid) 2) 32)
355 name 354 name
356 (make-string (/ (- cwid wid -1) 2) 32) 355 (make-string (/ (- cwid wid -1) 2) 32)
@@ -399,7 +398,6 @@
399 inv calc-inverse-flag) 398 inv calc-inverse-flag)
400 calc-hyperbolic-flag)) 399 calc-hyperbolic-flag))
401 (invhyp t) 400 (invhyp t)
402 (menu (symbol-value (nth calc-keypad-menu calc-keypad-menus)))
403 (input calc-keypad-input) 401 (input calc-keypad-input)
404 (iexpon (and input 402 (iexpon (and input
405 (or (string-match "\\*[0-9]+\\.\\^" input) 403 (or (string-match "\\*[0-9]+\\.\\^" input)
@@ -535,19 +533,22 @@
535 533
536(defun calc-keypad-left-click (event) 534(defun calc-keypad-left-click (event)
537 "Handle a left-button mouse click in Calc Keypad window." 535 "Handle a left-button mouse click in Calc Keypad window."
536 ;; FIXME: Why not use "@e" instead to select the buffer?
538 (interactive "e") 537 (interactive "e")
539 (with-current-buffer calc-keypad-buffer 538 (with-current-buffer calc-keypad-buffer
540 (goto-char (posn-point (event-start event))) 539 (goto-char (posn-point (event-start event)))
541 (calc-keypad-press))) 540 (calc-keypad-press)))
542 541
543(defun calc-keypad-right-click (event) 542(defun calc-keypad-right-click (_event)
544 "Handle a right-button mouse click in Calc Keypad window." 543 "Handle a right-button mouse click in Calc Keypad window."
544 ;; FIXME: Why not use "@e" instead to select the buffer?
545 (interactive "e") 545 (interactive "e")
546 (with-current-buffer calc-keypad-buffer 546 (with-current-buffer calc-keypad-buffer
547 (calc-keypad-menu))) 547 (calc-keypad-menu)))
548 548
549(defun calc-keypad-middle-click (event) 549(defun calc-keypad-middle-click (_event)
550 "Handle a middle-button mouse click in Calc Keypad window." 550 "Handle a middle-button mouse click in Calc Keypad window."
551 ;; FIXME: Why not use "@e" instead to select the buffer?
551 (interactive "e") 552 (interactive "e")
552 (with-current-buffer calc-keypad-buffer 553 (with-current-buffer calc-keypad-buffer
553 (calc-keypad-menu-back))) 554 (calc-keypad-menu-back)))
@@ -588,7 +589,6 @@
588(defun calc-keypad-execute () 589(defun calc-keypad-execute ()
589 (interactive) 590 (interactive)
590 (let* ((prompt "Calc keystrokes: ") 591 (let* ((prompt "Calc keystrokes: ")
591 (flush 'x-flush-mouse-queue)
592 (prefix nil) 592 (prefix nil)
593 keys cmd) 593 keys cmd)
594 (save-excursion 594 (save-excursion
@@ -605,10 +605,9 @@
605 (progn 605 (progn
606 (setq last-command-event (aref keys (1- (length keys)))) 606 (setq last-command-event (aref keys (1- (length keys))))
607 (command-execute cmd) 607 (command-execute cmd)
608 (setq flush 'not-any-more 608 (setq prefix t
609 prefix t
610 prompt (concat prompt (key-description keys) " "))) 609 prompt (concat prompt (key-description keys) " ")))
611 (eq cmd flush))))) ; skip mouse-up event 610 nil)))) ; skip mouse-up event
612 (message "") 611 (message "")
613 (if (commandp cmd) 612 (if (commandp cmd)
614 (command-execute cmd) 613 (command-execute cmd)
diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el
index 70d064143dc..da074d377b5 100644
--- a/lisp/calendar/timeclock.el
+++ b/lisp/calendar/timeclock.el
@@ -136,7 +136,7 @@ This variable only has effect if set with \\[customize]."
136 (if value 136 (if value
137 (add-hook 'kill-emacs-query-functions 'timeclock-query-out) 137 (add-hook 'kill-emacs-query-functions 'timeclock-query-out)
138 (remove-hook 'kill-emacs-query-functions 'timeclock-query-out)) 138 (remove-hook 'kill-emacs-query-functions 'timeclock-query-out))
139 (setq timeclock-ask-before-exiting value)) 139 (set symbol value))
140 :type 'boolean 140 :type 'boolean
141 :group 'timeclock) 141 :group 'timeclock)
142 142
@@ -174,11 +174,12 @@ a positive argument to force an update."
174 timeclock-update-timer))) 174 timeclock-update-timer)))
175 (setq currently-displaying nil)) 175 (setq currently-displaying nil))
176 (and currently-displaying 176 (and currently-displaying
177 (set-variable 'timeclock-mode-line-display nil)) 177 (setq timeclock-mode-line-display nil))
178 (setq timeclock-use-display-time value) 178 (set symbol value)
179 (and currently-displaying 179 (and currently-displaying
180 (set-variable 'timeclock-mode-line-display t)) 180 (setq timeclock-mode-line-display t))
181 timeclock-use-display-time)) 181 ;; FIXME: The return value isn't used, AFAIK!
182 value))
182 :type 'boolean 183 :type 'boolean
183 :group 'timeclock 184 :group 'timeclock
184 :require 'time) 185 :require 'time)
@@ -269,9 +270,11 @@ The time is bracketed by <> if you are clocked in, otherwise by [].")
269 270
270(define-obsolete-function-alias 'timeclock-modeline-display 271(define-obsolete-function-alias 'timeclock-modeline-display
271 'timeclock-mode-line-display "24.3") 272 'timeclock-mode-line-display "24.3")
273(define-obsolete-variable-alias 'timeclock-modeline-display
274 'timeclock-mode-line-display "24.3")
272 275
273;;;###autoload 276;;;###autoload
274(defun timeclock-mode-line-display (&optional arg) 277(define-minor-mode timeclock-mode-line-display
275 "Toggle display of the amount of time left today in the mode line. 278 "Toggle display of the amount of time left today in the mode line.
276If `timeclock-use-display-time' is non-nil (the default), then 279If `timeclock-use-display-time' is non-nil (the default), then
277the function `display-time-mode' must be active, and the mode line 280the function `display-time-mode' must be active, and the mode line
@@ -280,61 +283,41 @@ the timeclock will use its own sixty second timer to do its
280updating. With prefix ARG, turn mode line display on if and only 283updating. With prefix ARG, turn mode line display on if and only
281if ARG is positive. Returns the new status of timeclock mode line 284if ARG is positive. Returns the new status of timeclock mode line
282display (non-nil means on)." 285display (non-nil means on)."
283 (interactive "P") 286 :global t
284 ;; cf display-time-mode. 287 ;; cf display-time-mode.
285 (setq timeclock-mode-string "") 288 (setq timeclock-mode-string "")
286 (or global-mode-string (setq global-mode-string '(""))) 289 (or global-mode-string (setq global-mode-string '("")))
287 (let ((on-p (if arg 290 (if timeclock-mode-line-display
288 (> (prefix-numeric-value arg) 0) 291 (progn
289 (not timeclock-mode-line-display)))) 292 (or (memq 'timeclock-mode-string global-mode-string)
290 (if on-p 293 (setq global-mode-string
291 (progn 294 (append global-mode-string '(timeclock-mode-string))))
292 (or (memq 'timeclock-mode-string global-mode-string) 295 (add-hook 'timeclock-event-hook 'timeclock-update-mode-line)
293 (setq global-mode-string 296 (when timeclock-update-timer
294 (append global-mode-string '(timeclock-mode-string)))) 297 (cancel-timer timeclock-update-timer)
295 (add-hook 'timeclock-event-hook 'timeclock-update-mode-line) 298 (setq timeclock-update-timer nil))
296 (when timeclock-update-timer 299 (if (boundp 'display-time-hook)
297 (cancel-timer timeclock-update-timer) 300 (remove-hook 'display-time-hook 'timeclock-update-mode-line))
298 (setq timeclock-update-timer nil)) 301 (if timeclock-use-display-time
299 (if (boundp 'display-time-hook) 302 (progn
300 (remove-hook 'display-time-hook 'timeclock-update-mode-line)) 303 ;; Update immediately so there is a visible change
301 (if timeclock-use-display-time 304 ;; on calling this function.
302 (progn 305 (if display-time-mode
303 ;; Update immediately so there is a visible change 306 (timeclock-update-mode-line)
304 ;; on calling this function. 307 (message "Activate `display-time-mode' or turn off \
305 (if display-time-mode
306 (timeclock-update-mode-line)
307 (message "Activate `display-time-mode' or turn off \
308`timeclock-use-display-time' to see timeclock information")) 308`timeclock-use-display-time' to see timeclock information"))
309 (add-hook 'display-time-hook 'timeclock-update-mode-line)) 309 (add-hook 'display-time-hook 'timeclock-update-mode-line))
310 (setq timeclock-update-timer 310 (setq timeclock-update-timer
311 (run-at-time nil 60 'timeclock-update-mode-line)))) 311 (run-at-time nil 60 'timeclock-update-mode-line))))
312 (setq global-mode-string 312 (setq global-mode-string
313 (delq 'timeclock-mode-string global-mode-string)) 313 (delq 'timeclock-mode-string global-mode-string))
314 (remove-hook 'timeclock-event-hook 'timeclock-update-mode-line) 314 (remove-hook 'timeclock-event-hook 'timeclock-update-mode-line)
315 (if (boundp 'display-time-hook) 315 (if (boundp 'display-time-hook)
316 (remove-hook 'display-time-hook 316 (remove-hook 'display-time-hook
317 'timeclock-update-mode-line)) 317 'timeclock-update-mode-line))
318 (when timeclock-update-timer 318 (when timeclock-update-timer
319 (cancel-timer timeclock-update-timer) 319 (cancel-timer timeclock-update-timer)
320 (setq timeclock-update-timer nil))) 320 (setq timeclock-update-timer nil))))
321 (force-mode-line-update)
322 (setq timeclock-mode-line-display on-p)))
323
324(define-obsolete-variable-alias 'timeclock-modeline-display
325 'timeclock-mode-line-display "24.3")
326
327;; This has to be here so that the function definition of
328;; `timeclock-mode-line-display' is known to the "set" function.
329(defcustom timeclock-mode-line-display nil
330 "Toggle mode line display of time remaining.
331You must modify via \\[customize] for this variable to have an effect."
332 :set (lambda (symbol value)
333 (setq timeclock-mode-line-display
334 (timeclock-mode-line-display (or value 0))))
335 :type 'boolean
336 :group 'timeclock
337 :require 'timeclock)
338 321
339(defsubst timeclock-time-to-date (time) 322(defsubst timeclock-time-to-date (time)
340 "Convert the TIME value to a textual date string." 323 "Convert the TIME value to a textual date string."
@@ -835,25 +818,24 @@ This is only provided for coherency when used by
835 "Return a list of all the projects in DAY." 818 "Return a list of all the projects in DAY."
836 (timeclock-entry-list-projects (cddr day))) 819 (timeclock-entry-list-projects (cddr day)))
837 820
838(defmacro timeclock-day-list-template (func) 821(defun timeclock-day-list-template (func day-list)
839 "Template for summing the result of FUNC on each element of DAY-LIST." 822 "Template for summing the result of FUNC on each element of DAY-LIST."
840 `(let ((length 0)) 823 (let ((length 0))
841 (while day-list 824 (dolist (day day-list)
842 (setq length (+ length (,(eval func) (car day-list))) 825 (setq length (+ length (funcall func day))))
843 day-list (cdr day-list))) 826 length))
844 length))
845 827
846(defun timeclock-day-list-required (day-list) 828(defun timeclock-day-list-required (day-list)
847 "Return total required length of DAY-LIST, in seconds." 829 "Return total required length of DAY-LIST, in seconds."
848 (timeclock-day-list-template 'timeclock-day-required)) 830 (timeclock-day-list-template #'timeclock-day-required day-list))
849 831
850(defun timeclock-day-list-length (day-list) 832(defun timeclock-day-list-length (day-list)
851 "Return actual length of DAY-LIST, in seconds." 833 "Return actual length of DAY-LIST, in seconds."
852 (timeclock-day-list-template 'timeclock-day-length)) 834 (timeclock-day-list-template #'timeclock-day-length day-list))
853 835
854(defun timeclock-day-list-debt (day-list) 836(defun timeclock-day-list-debt (day-list)
855 "Return total debt (required - actual) of DAY-LIST." 837 "Return total debt (required - actual) of DAY-LIST."
856 (timeclock-day-list-template 'timeclock-day-debt)) 838 (timeclock-day-list-template #'timeclock-day-debt day-list))
857 839
858(defsubst timeclock-day-list-begin (day-list) 840(defsubst timeclock-day-list-begin (day-list)
859 "Return the start time of DAY-LIST." 841 "Return the start time of DAY-LIST."
@@ -865,11 +847,11 @@ This is only provided for coherency when used by
865 847
866(defun timeclock-day-list-span (day-list) 848(defun timeclock-day-list-span (day-list)
867 "Return the span of DAY-LIST." 849 "Return the span of DAY-LIST."
868 (timeclock-day-list-template 'timeclock-day-span)) 850 (timeclock-day-list-template #'timeclock-day-span day-list))
869 851
870(defun timeclock-day-list-break (day-list) 852(defun timeclock-day-list-break (day-list)
871 "Return the total break of DAY-LIST." 853 "Return the total break of DAY-LIST."
872 (timeclock-day-list-template 'timeclock-day-break)) 854 (timeclock-day-list-template #'timeclock-day-break day-list))
873 855
874(defun timeclock-day-list-projects (day-list) 856(defun timeclock-day-list-projects (day-list)
875 "Return a list of all the projects in DAY-LIST." 857 "Return a list of all the projects in DAY-LIST."
diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el
index b7e553272f2..4cb089aca97 100644
--- a/lisp/emacs-lisp/pp.el
+++ b/lisp/emacs-lisp/pp.el
@@ -127,8 +127,7 @@ after OUT-BUFFER-NAME."
127 "Evaluate EXPRESSION and pretty-print its value. 127 "Evaluate EXPRESSION and pretty-print its value.
128Also add the value to the front of the list in the variable `values'." 128Also add the value to the front of the list in the variable `values'."
129 (interactive 129 (interactive
130 (list (read-from-minibuffer "Eval: " nil read-expression-map t 130 (list (read--expression "Eval: ")))
131 'read-expression-history)))
132 (message "Evaluating...") 131 (message "Evaluating...")
133 (setq values (cons (eval expression) values)) 132 (setq values (cons (eval expression) values))
134 (pp-display-expression (car values) "*Pp Eval Output*")) 133 (pp-display-expression (car values) "*Pp Eval Output*"))
@@ -137,8 +136,7 @@ Also add the value to the front of the list in the variable `values'."
137(defun pp-macroexpand-expression (expression) 136(defun pp-macroexpand-expression (expression)
138 "Macroexpand EXPRESSION and pretty-print its value." 137 "Macroexpand EXPRESSION and pretty-print its value."
139 (interactive 138 (interactive
140 (list (read-from-minibuffer "Macroexpand: " nil read-expression-map t 139 (list (read--expression "Macroexpand: ")))
141 'read-expression-history)))
142 (pp-display-expression (macroexpand expression) "*Pp Macroexpand Output*")) 140 (pp-display-expression (macroexpand expression) "*Pp Macroexpand Output*"))
143 141
144(defun pp-last-sexp () 142(defun pp-last-sexp ()
diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog
index a23fa508c46..e0628dbb80a 100644
--- a/lisp/erc/ChangeLog
+++ b/lisp/erc/ChangeLog
@@ -1,3 +1,34 @@
12013-08-22 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * erc.el: Use lexical-binding.
4 (erc-user-full-name): Minor CSE simplification.
5 (erc-mode-map): Assume command-remapping is available.
6 (erc-once-with-server-event): Replace `forms' arg with a function arg.
7 (erc-once-with-server-event-global): Remove.
8 (erc-ison-p): Adjust to change in erc-once-with-server-event.
9 (erc-get-buffer-create): Remove arg `proc'.
10 (iswitchb-make-buflist-hook): Declare.
11 (erc-setup-buffer): Use pcase; avoid ((lambda ..) ..).
12 (read-passwd): Assume it exists.
13 (erc-display-line, erc-cmd-IDLE): Avoid add-to-list, adjust to change
14 in erc-once-with-server-event.
15 (erc-cmd-JOIN, erc-set-channel-limit, erc-set-channel-key)
16 (erc-add-query): Minor CSE simplification.
17 (erc-cmd-BANLIST, erc-cmd-MASSUNBAN): Adjust to change
18 in erc-once-with-server-event.
19 (erc-echo-notice-in-user-and-target-buffers): Avoid add-to-list.
20 * erc-track.el: Use lexical-binding.
21 (erc-make-mode-line-buffer-name): Use closures instead of `(lambda...).
22 (erc-faces-in): Avoid add-to-list.
23 * erc-notify.el: Use lexical-binding.
24 (erc-notify-timer): Adjust to change in erc-once-with-server-event.
25 (erc-notify-QUIT): Use a closure instead of `(lambda...).
26 * erc-list.el: Use lexical-binding.
27 (erc-list-install-322-handler, erc-cmd-LIST): Adjust to change in
28 erc-once-with-server-event.
29 * erc-button.el: Use lexical-binding.
30 (erc-button-next-function): Use a closure instead of `(lambda...).
31
12013-05-30 Glenn Morris <rgm@gnu.org> 322013-05-30 Glenn Morris <rgm@gnu.org>
2 33
3 * erc-backend.el: Require erc at run-time too. 34 * erc-backend.el: Require erc at run-time too.
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 24150138e12..ac8600c57fd 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -1,4 +1,4 @@
1;; erc-button.el --- A way of buttonizing certain things in ERC buffers 1;; erc-button.el --- A way of buttonizing certain things in ERC buffers -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 1996-2004, 2006-2013 Free Software Foundation, Inc. 3;; Copyright (C) 1996-2004, 2006-2013 Free Software Foundation, Inc.
4 4
@@ -432,19 +432,22 @@ call it with the value of the `erc-data' text property."
432(defun erc-button-next-function () 432(defun erc-button-next-function ()
433 "Pseudo completion function that actually jumps to the next button. 433 "Pseudo completion function that actually jumps to the next button.
434For use on `completion-at-point-functions'." 434For use on `completion-at-point-functions'."
435 (when (< (point) (erc-beg-of-input-line)) 435 ;; FIXME: This is an abuse of completion-at-point-functions.
436 `(lambda () 436 (when (< (point) (erc-beg-of-input-line))
437 (let ((here ,(point))) 437 (let ((start (point)))
438 (while (and (get-text-property here 'erc-callback) 438 (lambda ()
439 (not (= here (point-max)))) 439 (let ((here start))
440 (setq here (1+ here))) 440 ;; FIXME: Use next-single-property-change.
441 (while (and (not (get-text-property here 'erc-callback)) 441 (while (and (get-text-property here 'erc-callback)
442 (not (= here (point-max)))) 442 (not (= here (point-max))))
443 (setq here (1+ here))) 443 (setq here (1+ here)))
444 (if (< here (point-max)) 444 (while (not (or (get-text-property here 'erc-callback)
445 (goto-char here) 445 (= here (point-max))))
446 (error "No next button")) 446 (setq here (1+ here)))
447 t)))) 447 (if (< here (point-max))
448 (goto-char here)
449 (error "No next button"))
450 t)))))
448 451
449(defun erc-button-next () 452(defun erc-button-next ()
450 "Go to the next button in this buffer." 453 "Go to the next button in this buffer."
diff --git a/lisp/erc/erc-list.el b/lisp/erc/erc-list.el
index f11dd98ca37..c243073790e 100644
--- a/lisp/erc/erc-list.el
+++ b/lisp/erc/erc-list.el
@@ -1,4 +1,4 @@
1;;; erc-list.el --- /list support for ERC 1;;; erc-list.el --- /list support for ERC -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 2008-2013 Free Software Foundation, Inc. 3;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
4 4
@@ -183,7 +183,7 @@
183 ;; Arrange for 323 (end of list) to end this. 183 ;; Arrange for 323 (end of list) to end this.
184 (erc-once-with-server-event 184 (erc-once-with-server-event
185 323 185 323
186 '(progn 186 (lambda (_proc _parsed)
187 (remove-hook 'erc-server-322-functions 'erc-list-handle-322 t))) 187 (remove-hook 'erc-server-322-functions 'erc-list-handle-322 t)))
188 ;; Find the list buffer, empty it, and display it. 188 ;; Find the list buffer, empty it, and display it.
189 (set (make-local-variable 'erc-list-buffer) 189 (set (make-local-variable 'erc-list-buffer)
@@ -209,11 +209,12 @@ should usually be one or more channels, separated by commas.
209Please note that this function only works with IRC servers which conform 209Please note that this function only works with IRC servers which conform
210to RFC and send the LIST header (#321) at start of list transmission." 210to RFC and send the LIST header (#321) at start of list transmission."
211 (erc-with-server-buffer 211 (erc-with-server-buffer
212 (set (make-local-variable 'erc-list-last-argument) line) 212 (set (make-local-variable 'erc-list-last-argument) line)
213 (erc-once-with-server-event 213 (erc-once-with-server-event
214 321 214 321
215 (list 'progn 215 (let ((buf (current-buffer)))
216 (list 'erc-list-install-322-handler (current-buffer))))) 216 (lambda (_proc _parsed)
217 (erc-list-install-322-handler buf)))))
217 (erc-server-send (concat "LIST :" (or (and line (substring line 1)) 218 (erc-server-send (concat "LIST :" (or (and line (substring line 1))
218 "")))) 219 ""))))
219(put 'erc-cmd-LIST 'do-not-parse-args t) 220(put 'erc-cmd-LIST 'do-not-parse-args t)
diff --git a/lisp/erc/erc-notify.el b/lisp/erc/erc-notify.el
index db7067eec08..064bb53f215 100644
--- a/lisp/erc/erc-notify.el
+++ b/lisp/erc/erc-notify.el
@@ -1,4 +1,4 @@
1;;; erc-notify.el --- Online status change notification 1;;; erc-notify.el --- Online status change notification -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 2002-2004, 2006-2013 Free Software Foundation, Inc. 3;; Copyright (C) 2002-2004, 2006-2013 Free Software Foundation, Inc.
4 4
@@ -115,27 +115,28 @@ changes."
115 erc-notify-interval)) 115 erc-notify-interval))
116 (erc-once-with-server-event 116 (erc-once-with-server-event
117 303 117 303
118 '(let* ((server (erc-response.sender parsed)) 118 (lambda (proc parsed)
119 (ison-list (delete "" (split-string 119 (let* ((server (erc-response.sender parsed))
120 (erc-response.contents parsed)))) 120 (ison-list (delete "" (split-string
121 (new-list ison-list) 121 (erc-response.contents parsed))))
122 (old-list (erc-with-server-buffer erc-last-ison))) 122 (new-list ison-list)
123 (while new-list 123 (old-list (erc-with-server-buffer erc-last-ison)))
124 (when (not (erc-member-ignore-case (car new-list) old-list)) 124 (while new-list
125 (run-hook-with-args 'erc-notify-signon-hook server (car new-list)) 125 (when (not (erc-member-ignore-case (car new-list) old-list))
126 (erc-display-message 126 (run-hook-with-args 'erc-notify-signon-hook server (car new-list))
127 parsed 'notice proc 127 (erc-display-message
128 'notify_on ?n (car new-list) ?m (erc-network-name))) 128 parsed 'notice proc
129 (setq new-list (cdr new-list))) 129 'notify_on ?n (car new-list) ?m (erc-network-name)))
130 (while old-list 130 (setq new-list (cdr new-list)))
131 (when (not (erc-member-ignore-case (car old-list) ison-list)) 131 (while old-list
132 (run-hook-with-args 'erc-notify-signoff-hook server (car old-list)) 132 (when (not (erc-member-ignore-case (car old-list) ison-list))
133 (erc-display-message 133 (run-hook-with-args 'erc-notify-signoff-hook server (car old-list))
134 parsed 'notice proc 134 (erc-display-message
135 'notify_off ?n (car old-list) ?m (erc-network-name))) 135 parsed 'notice proc
136 (setq old-list (cdr old-list))) 136 'notify_off ?n (car old-list) ?m (erc-network-name)))
137 (setq erc-last-ison ison-list) 137 (setq old-list (cdr old-list)))
138 t)) 138 (setq erc-last-ison ison-list)
139 t)))
139 (erc-server-send 140 (erc-server-send
140 (concat "ISON " (mapconcat 'identity erc-notify-list " "))) 141 (concat "ISON " (mapconcat 'identity erc-notify-list " ")))
141 (setq erc-last-ison-time now))) 142 (setq erc-last-ison-time now)))
@@ -179,10 +180,11 @@ nick from `erc-last-ison' to prevent any further notifications."
179 (let ((nick (erc-extract-nick (erc-response.sender parsed)))) 180 (let ((nick (erc-extract-nick (erc-response.sender parsed))))
180 (when (and (erc-member-ignore-case nick erc-notify-list) 181 (when (and (erc-member-ignore-case nick erc-notify-list)
181 (erc-member-ignore-case nick erc-last-ison)) 182 (erc-member-ignore-case nick erc-last-ison))
182 (setq erc-last-ison (erc-delete-if `(lambda (el) 183 (setq erc-last-ison (erc-delete-if
183 (string= ,(erc-downcase nick) 184 (let ((nick-down (erc-downcase nick)))
184 (erc-downcase el))) 185 (lambda (el)
185 erc-last-ison)) 186 (string= nick-down (erc-downcase el))))
187 erc-last-ison))
186 (run-hook-with-args 'erc-notify-signoff-hook 188 (run-hook-with-args 'erc-notify-signoff-hook
187 (or erc-server-announced-name erc-session-server) 189 (or erc-server-announced-name erc-session-server)
188 nick) 190 nick)
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index 054c135fa67..e6d5b3119a2 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -1,4 +1,4 @@
1;;; erc-track.el --- Track modified channel buffers 1;;; erc-track.el --- Track modified channel buffers -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 2002-2013 Free Software Foundation, Inc. 3;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
4 4
@@ -710,7 +710,7 @@ inactive."
710to consider when `erc-track-visibility' is set to 710to consider when `erc-track-visibility' is set to
711only consider active buffers visible.") 711only consider active buffers visible.")
712 712
713(defun erc-user-is-active (&rest ignore) 713(defun erc-user-is-active (&rest _ignore)
714 "Set `erc-buffer-activity'." 714 "Set `erc-buffer-activity'."
715 (when erc-server-connected 715 (when erc-server-connected
716 (setq erc-buffer-activity (erc-current-time)) 716 (setq erc-buffer-activity (erc-current-time))
@@ -745,7 +745,7 @@ only consider active buffers visible.")
745times. Without it, you cannot debug `erc-modified-channels-display', 745times. Without it, you cannot debug `erc-modified-channels-display',
746because the debugger also cases changes to the window-configuration.") 746because the debugger also cases changes to the window-configuration.")
747 747
748(defun erc-modified-channels-update (&rest args) 748(defun erc-modified-channels-update (&rest _args)
749 "This function updates the information in `erc-modified-channels-alist' 749 "This function updates the information in `erc-modified-channels-alist'
750according to buffer visibility. It calls 750according to buffer visibility. It calls
751`erc-modified-channels-display' at the end. This should usually be 751`erc-modified-channels-display' at the end. This should usually be
@@ -791,19 +791,19 @@ If FACES are provided, color STRING with them."
791 (int-to-string count)) 791 (int-to-string count))
792 (copy-sequence string)))) 792 (copy-sequence string))))
793 (define-key map (vector 'mode-line 'mouse-2) 793 (define-key map (vector 'mode-line 'mouse-2)
794 `(lambda (e) 794 (lambda (e)
795 (interactive "e") 795 (interactive "e")
796 (save-selected-window 796 (save-selected-window
797 (select-window 797 (select-window
798 (posn-window (event-start e))) 798 (posn-window (event-start e)))
799 (switch-to-buffer ,buffer)))) 799 (switch-to-buffer buffer))))
800 (define-key map (vector 'mode-line 'mouse-3) 800 (define-key map (vector 'mode-line 'mouse-3)
801 `(lambda (e) 801 (lambda (e)
802 (interactive "e") 802 (interactive "e")
803 (save-selected-window 803 (save-selected-window
804 (select-window 804 (select-window
805 (posn-window (event-start e))) 805 (posn-window (event-start e)))
806 (switch-to-buffer-other-window ,buffer)))) 806 (switch-to-buffer-other-window buffer))))
807 (put-text-property 0 (length name) 'local-map map name) 807 (put-text-property 0 (length name) 'local-map map name)
808 (put-text-property 808 (put-text-property
809 0 (length name) 809 0 (length name)
@@ -976,8 +976,9 @@ is in `erc-mode'."
976 cur) 976 cur)
977 (while (and (setq i (next-single-property-change i 'face str m)) 977 (while (and (setq i (next-single-property-change i 'face str m))
978 (not (= i m))) 978 (not (= i m)))
979 (when (setq cur (get-text-property i 'face str)) 979 (and (setq cur (get-text-property i 'face str))
980 (add-to-list 'faces cur))) 980 (not (member cur faces))
981 (push cur faces)))
981 faces)) 982 faces))
982 983
983(cl-assert 984(cl-assert
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index b2724b9737f..0bfd21d6c3a 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1,4 +1,4 @@
1;; erc.el --- An Emacs Internet Relay Chat client 1;; erc.el --- An Emacs Internet Relay Chat client -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 1997-2013 Free Software Foundation, Inc. 3;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
4 4
@@ -125,20 +125,11 @@
125 125
126;; compatibility with older ERC releases 126;; compatibility with older ERC releases
127 127
128(if (fboundp 'defvaralias) 128(define-obsolete-variable-alias 'erc-announced-server-name
129 (progn 129 'erc-server-announced-name "ERC 5.1")
130 (defvaralias 'erc-announced-server-name 'erc-server-announced-name) 130(define-obsolete-variable-alias 'erc-process 'erc-server-process "ERC 5.1")
131 (erc-make-obsolete-variable 'erc-announced-server-name 131(define-obsolete-variable-alias 'erc-default-coding-system
132 'erc-server-announced-name 132 'erc-server-coding-system "ERC 5.1")
133 "ERC 5.1")
134 (defvaralias 'erc-process 'erc-server-process)
135 (erc-make-obsolete-variable 'erc-process 'erc-server-process "ERC 5.1")
136 (defvaralias 'erc-default-coding-system 'erc-server-coding-system)
137 (erc-make-obsolete-variable 'erc-default-coding-system
138 'erc-server-coding-system
139 "ERC 5.1"))
140 (message (concat "ERC: The function `defvaralias' is not bound. See the "
141 "NEWS file for variable name changes since ERC 5.0.4.")))
142 133
143(define-obsolete-function-alias 'erc-send-command 134(define-obsolete-function-alias 'erc-send-command
144 'erc-server-send "ERC 5.1") 135 'erc-server-send "ERC 5.1")
@@ -201,9 +192,7 @@ parameters and authentication."
201 (string :tag "Name") 192 (string :tag "Name")
202 (function :tag "Get from function")) 193 (function :tag "Get from function"))
203 :set (lambda (sym val) 194 :set (lambda (sym val)
204 (if (functionp val) 195 (set sym (if (functionp val) (funcall val) val))))
205 (set sym (funcall val))
206 (set sym val))))
207 196
208(defvar erc-password nil 197(defvar erc-password nil
209 "Password to use when authenticating to an IRC server. 198 "Password to use when authenticating to an IRC server.
@@ -388,12 +377,12 @@ If no server buffer exists, return nil."
388 (last-message-time nil)) 377 (last-message-time nil))
389 378
390(defsubst erc-get-channel-user (nick) 379(defsubst erc-get-channel-user (nick)
391 "Finds the (USER . CHANNEL-DATA) element corresponding to NICK 380 "Find the (USER . CHANNEL-DATA) element corresponding to NICK
392in the current buffer's `erc-channel-users' hash table." 381in the current buffer's `erc-channel-users' hash table."
393 (gethash (erc-downcase nick) erc-channel-users)) 382 (gethash (erc-downcase nick) erc-channel-users))
394 383
395(defsubst erc-get-server-user (nick) 384(defsubst erc-get-server-user (nick)
396 "Finds the USER corresponding to NICK in the current server's 385 "Find the USER corresponding to NICK in the current server's
397`erc-server-users' hash table." 386`erc-server-users' hash table."
398 (erc-with-server-buffer 387 (erc-with-server-buffer
399 (gethash (erc-downcase nick) erc-server-users))) 388 (gethash (erc-downcase nick) erc-server-users)))
@@ -480,7 +469,7 @@ Removes all users in the current channel. This is called by
480 (when (and erc-server-connected 469 (when (and erc-server-connected
481 (erc-server-process-alive) 470 (erc-server-process-alive)
482 (hash-table-p erc-channel-users)) 471 (hash-table-p erc-channel-users))
483 (maphash (lambda (nick cdata) 472 (maphash (lambda (nick _cdata)
484 (erc-remove-channel-user nick)) 473 (erc-remove-channel-user nick))
485 erc-channel-users) 474 erc-channel-users)
486 (clrhash erc-channel-users))) 475 (clrhash erc-channel-users)))
@@ -502,25 +491,25 @@ Removes all users in the current channel. This is called by
502 (erc-channel-user-voice (cdr cdata)))))) 491 (erc-channel-user-voice (cdr cdata))))))
503 492
504(defun erc-get-channel-user-list () 493(defun erc-get-channel-user-list ()
505 "Returns a list of users in the current channel. Each element 494 "Return a list of users in the current channel. Each element
506of the list is of the form (USER . CHANNEL-DATA), where USER is 495of the list is of the form (USER . CHANNEL-DATA), where USER is
507an erc-server-user struct, and CHANNEL-DATA is either `nil' or an 496an erc-server-user struct, and CHANNEL-DATA is either nil or an
508erc-channel-user struct. 497erc-channel-user struct.
509 498
510See also: `erc-sort-channel-users-by-activity'" 499See also: `erc-sort-channel-users-by-activity'"
511 (let (users) 500 (let (users)
512 (if (hash-table-p erc-channel-users) 501 (if (hash-table-p erc-channel-users)
513 (maphash (lambda (nick cdata) 502 (maphash (lambda (_nick cdata)
514 (setq users (cons cdata users))) 503 (setq users (cons cdata users)))
515 erc-channel-users)) 504 erc-channel-users))
516 users)) 505 users))
517 506
518(defun erc-get-server-nickname-list () 507(defun erc-get-server-nickname-list ()
519 "Returns a list of known nicknames on the current server." 508 "Return a list of known nicknames on the current server."
520 (erc-with-server-buffer 509 (erc-with-server-buffer
521 (let (nicks) 510 (let (nicks)
522 (when (hash-table-p erc-server-users) 511 (when (hash-table-p erc-server-users)
523 (maphash (lambda (n user) 512 (maphash (lambda (_n user)
524 (setq nicks 513 (setq nicks
525 (cons (erc-server-user-nickname user) 514 (cons (erc-server-user-nickname user)
526 nicks))) 515 nicks)))
@@ -528,10 +517,10 @@ See also: `erc-sort-channel-users-by-activity'"
528 nicks)))) 517 nicks))))
529 518
530(defun erc-get-channel-nickname-list () 519(defun erc-get-channel-nickname-list ()
531 "Returns a list of known nicknames on the current channel." 520 "Return a list of known nicknames on the current channel."
532 (let (nicks) 521 (let (nicks)
533 (when (hash-table-p erc-channel-users) 522 (when (hash-table-p erc-channel-users)
534 (maphash (lambda (n cdata) 523 (maphash (lambda (_n cdata)
535 (setq nicks 524 (setq nicks
536 (cons (erc-server-user-nickname (car cdata)) 525 (cons (erc-server-user-nickname (car cdata))
537 nicks))) 526 nicks)))
@@ -539,11 +528,11 @@ See also: `erc-sort-channel-users-by-activity'"
539 nicks))) 528 nicks)))
540 529
541(defun erc-get-server-nickname-alist () 530(defun erc-get-server-nickname-alist ()
542 "Returns an alist of known nicknames on the current server." 531 "Return an alist of known nicknames on the current server."
543 (erc-with-server-buffer 532 (erc-with-server-buffer
544 (let (nicks) 533 (let (nicks)
545 (when (hash-table-p erc-server-users) 534 (when (hash-table-p erc-server-users)
546 (maphash (lambda (n user) 535 (maphash (lambda (_n user)
547 (setq nicks 536 (setq nicks
548 (cons (cons (erc-server-user-nickname user) nil) 537 (cons (cons (erc-server-user-nickname user) nil)
549 nicks))) 538 nicks)))
@@ -551,10 +540,10 @@ See also: `erc-sort-channel-users-by-activity'"
551 nicks)))) 540 nicks))))
552 541
553(defun erc-get-channel-nickname-alist () 542(defun erc-get-channel-nickname-alist ()
554 "Returns an alist of known nicknames on the current channel." 543 "Return an alist of known nicknames on the current channel."
555 (let (nicks) 544 (let (nicks)
556 (when (hash-table-p erc-channel-users) 545 (when (hash-table-p erc-channel-users)
557 (maphash (lambda (n cdata) 546 (maphash (lambda (_n cdata)
558 (setq nicks 547 (setq nicks
559 (cons (cons (erc-server-user-nickname (car cdata)) nil) 548 (cons (cons (erc-server-user-nickname (car cdata)) nil)
560 nicks))) 549 nicks)))
@@ -562,21 +551,18 @@ See also: `erc-sort-channel-users-by-activity'"
562 nicks))) 551 nicks)))
563 552
564(defun erc-sort-channel-users-by-activity (list) 553(defun erc-sort-channel-users-by-activity (list)
565 "Sorts LIST such that users which have spoken most recently are 554 "Sort LIST such that users which have spoken most recently are listed first.
566listed first. LIST must be of the form (USER . CHANNEL-DATA). 555LIST must be of the form (USER . CHANNEL-DATA).
567 556
568See also: `erc-get-channel-user-list'." 557See also: `erc-get-channel-user-list'."
569 (sort list 558 (sort list
570 (lambda (x y) 559 (lambda (x y)
571 (when (and 560 (when (and (cdr x) (cdr y))
572 (cdr x) (cdr y))
573 (let ((tx (erc-channel-user-last-message-time (cdr x))) 561 (let ((tx (erc-channel-user-last-message-time (cdr x)))
574 (ty (erc-channel-user-last-message-time (cdr y)))) 562 (ty (erc-channel-user-last-message-time (cdr y))))
575 (if tx 563 (and tx
576 (if ty 564 (or (not ty)
577 (time-less-p ty tx) 565 (time-less-p ty tx))))))))
578 t)
579 nil))))))
580 566
581(defun erc-sort-channel-users-alphabetically (list) 567(defun erc-sort-channel-users-alphabetically (list)
582 "Sort LIST so that users' nicknames are in alphabetical order. 568 "Sort LIST so that users' nicknames are in alphabetical order.
@@ -585,15 +571,12 @@ LIST must be of the form (USER . CHANNEL-DATA).
585See also: `erc-get-channel-user-list'." 571See also: `erc-get-channel-user-list'."
586 (sort list 572 (sort list
587 (lambda (x y) 573 (lambda (x y)
588 (when (and 574 (when (and (cdr x) (cdr y))
589 (cdr x) (cdr y))
590 (let ((nickx (downcase (erc-server-user-nickname (car x)))) 575 (let ((nickx (downcase (erc-server-user-nickname (car x))))
591 (nicky (downcase (erc-server-user-nickname (car y))))) 576 (nicky (downcase (erc-server-user-nickname (car y)))))
592 (if nickx 577 (and nickx
593 (if nicky 578 (or (not nicky)
594 (string-lessp nickx nicky) 579 (string-lessp nickx nicky))))))))
595 t)
596 nil))))))
597 580
598(defvar erc-channel-topic nil 581(defvar erc-channel-topic nil
599 "A topic string for the channel. Should only be used in channel-buffers.") 582 "A topic string for the channel. Should only be used in channel-buffers.")
@@ -678,8 +661,8 @@ Any other value disables notice's highlighting altogether."
678 (const :tag "don't highlight notices at all" nil))) 661 (const :tag "don't highlight notices at all" nil)))
679 662
680(defcustom erc-echo-notice-hook nil 663(defcustom erc-echo-notice-hook nil
681 "Specifies a list of functions to call to echo a private 664 "List of functions to call to echo a private notice.
682notice. Each function is called with four arguments, the string 665Each function is called with four arguments, the string
683to display, the parsed server message, the target buffer (or 666to display, the parsed server message, the target buffer (or
684nil), and the sender. The functions are called in order, until a 667nil), and the sender. The functions are called in order, until a
685function evaluates to non-nil. These hooks are called after 668function evaluates to non-nil. These hooks are called after
@@ -709,8 +692,8 @@ See also: `erc-echo-notice-always-hook',
709 692
710(defcustom erc-echo-notice-always-hook 693(defcustom erc-echo-notice-always-hook
711 '(erc-echo-notice-in-default-buffer) 694 '(erc-echo-notice-in-default-buffer)
712 "Specifies a list of functions to call to echo a private 695 "List of functions to call to echo a private notice.
713notice. Each function is called with four arguments, the string 696Each function is called with four arguments, the string
714to display, the parsed server message, the target buffer (or 697to display, the parsed server message, the target buffer (or
715nil), and the sender. The functions are called in order, and all 698nil), and the sender. The functions are called in order, and all
716functions are called. These hooks are called before those 699functions are called. These hooks are called before those
@@ -1062,9 +1045,9 @@ This function is called with narrowing, ala `erc-send-modify-hook'."
1062 :options '(erc-make-read-only)) 1045 :options '(erc-make-read-only))
1063 1046
1064(defcustom erc-send-completed-hook 1047(defcustom erc-send-completed-hook
1065 (when (featurep 'emacspeak) 1048 (when (fboundp 'emacspeak-auditory-icon)
1066 (list (byte-compile 1049 (list (byte-compile
1067 (lambda (str) 1050 (lambda (_str)
1068 (emacspeak-auditory-icon 'select-object))))) 1051 (emacspeak-auditory-icon 'select-object)))))
1069 "Hook called after a message has been parsed by ERC. 1052 "Hook called after a message has been parsed by ERC.
1070 1053
@@ -1115,10 +1098,7 @@ which the local user typed."
1115 1098
1116 ;; Suppress `font-lock-fontify-block' key binding since it 1099 ;; Suppress `font-lock-fontify-block' key binding since it
1117 ;; destroys face properties. 1100 ;; destroys face properties.
1118 (if (fboundp 'command-remapping) 1101 (define-key map [remap font-lock-fontify-block] 'undefined)
1119 (define-key map [remap font-lock-fontify-block] 'undefined)
1120 (substitute-key-definition
1121 'font-lock-fontify-block 'undefined map global-map))
1122 1102
1123 map) 1103 map)
1124 "ERC keymap.") 1104 "ERC keymap.")
@@ -1277,14 +1257,14 @@ if ARG is omitted or nil.
1277 (put ',enable 'definition-name ',name) 1257 (put ',enable 'definition-name ',name)
1278 (put ',disable 'definition-name ',name)))) 1258 (put ',disable 'definition-name ',name))))
1279 1259
1280(defun erc-once-with-server-event (event &rest forms) 1260(defun erc-once-with-server-event (event f)
1281 "Execute FORMS the next time EVENT occurs in the `current-buffer'. 1261 "Run function F the next time EVENT occurs in the `current-buffer'.
1282 1262
1283You should make sure that `current-buffer' is a server buffer. 1263You should make sure that `current-buffer' is a server buffer.
1284 1264
1285This function temporarily adds a function to EVENT's hook to 1265This function temporarily adds a function to EVENT's hook to call F with
1286execute FORMS. After FORMS are run, the function is removed from 1266two arguments (`proc' and `parsed'). After F is called, the function is
1287EVENT's hook. The last expression of FORMS should be either nil 1267removed from EVENT's hook. F should return either nil
1288or t, where nil indicates that the other functions on EVENT's hook 1268or t, where nil indicates that the other functions on EVENT's hook
1289should be run too, and t indicates that other functions should 1269should be run too, and t indicates that other functions should
1290not be run. 1270not be run.
@@ -1298,35 +1278,14 @@ capabilities."
1298 "You should only run `erc-once-with-server-event' in a server buffer")) 1278 "You should only run `erc-once-with-server-event' in a server buffer"))
1299 (let ((fun (make-symbol "fun")) 1279 (let ((fun (make-symbol "fun"))
1300 (hook (erc-get-hook event))) 1280 (hook (erc-get-hook event)))
1301 (put fun 'erc-original-buffer (current-buffer)) 1281 (put fun 'erc-original-buffer (current-buffer))
1302 (fset fun `(lambda (proc parsed) 1282 (fset fun (lambda (proc parsed)
1303 (with-current-buffer (get ',fun 'erc-original-buffer) 1283 (with-current-buffer (get fun 'erc-original-buffer)
1304 (remove-hook ',hook ',fun t)) 1284 (remove-hook hook fun t))
1305 (fmakunbound ',fun) 1285 (fmakunbound fun)
1306 ,@forms)) 1286 (funcall f proc parsed)))
1307 (add-hook hook fun nil t) 1287 (add-hook hook fun nil t)
1308 fun)) 1288 fun))
1309
1310(defun erc-once-with-server-event-global (event &rest forms)
1311 "Execute FORMS the next time EVENT occurs in any server buffer.
1312
1313This function temporarily prepends a function to EVENT's hook to
1314execute FORMS. After FORMS are run, the function is removed from
1315EVENT's hook. The last expression of FORMS should be either nil
1316or t, where nil indicates that the other functions on EVENT's hook
1317should be run too, and t indicates that other functions should
1318not be run.
1319
1320When FORMS execute, the current buffer is the server buffer associated with the
1321connection over which the data was received that triggered EVENT."
1322 (let ((fun (make-symbol "fun"))
1323 (hook (erc-get-hook event)))
1324 (fset fun `(lambda (proc parsed)
1325 (remove-hook ',hook ',fun)
1326 (fmakunbound ',fun)
1327 ,@forms))
1328 (add-hook hook fun nil nil)
1329 fun))
1330 1289
1331(defsubst erc-log (string) 1290(defsubst erc-log (string)
1332 "Logs STRING if logging is on (see `erc-log-p')." 1291 "Logs STRING if logging is on (see `erc-log-p')."
@@ -1353,7 +1312,7 @@ If BUFFER is nil, the current buffer is used."
1353 (and (eq major-mode 'erc-mode) 1312 (and (eq major-mode 'erc-mode)
1354 (null (erc-default-target))))) 1313 (null (erc-default-target)))))
1355 1314
1356(defun erc-open-server-buffer-p (&optional buffer) 1315(defun erc-open-server-buffer-p (&optional buffer) ;FIXME: `buffer' is ignored!
1357 "Return non-nil if argument BUFFER is an ERC server buffer that 1316 "Return non-nil if argument BUFFER is an ERC server buffer that
1358has an open IRC process. 1317has an open IRC process.
1359 1318
@@ -1377,9 +1336,10 @@ If BUFFER is nil, the current buffer is used."
1377 (let ((erc-online-p 'unknown)) 1336 (let ((erc-online-p 'unknown))
1378 (erc-once-with-server-event 1337 (erc-once-with-server-event
1379 303 1338 303
1380 `(let ((ison (split-string (aref parsed 3)))) 1339 (lambda (_proc parsed)
1381 (setq erc-online-p (car (erc-member-ignore-case ,nick ison))) 1340 (let ((ison (split-string (aref parsed 3))))
1382 t)) 1341 (setq erc-online-p (car (erc-member-ignore-case nick ison)))
1342 t)))
1383 (erc-server-send (format "ISON %s" nick)) 1343 (erc-server-send (format "ISON %s" nick))
1384 (while (eq erc-online-p 'unknown) (accept-process-output)) 1344 (while (eq erc-online-p 'unknown) (accept-process-output))
1385 (if (called-interactively-p 'interactive) 1345 (if (called-interactively-p 'interactive)
@@ -1551,7 +1511,7 @@ symbol, it may have these values:
1551 "Check whether ports A and B are equal." 1511 "Check whether ports A and B are equal."
1552 (= (erc-normalize-port a) (erc-normalize-port b))) 1512 (= (erc-normalize-port a) (erc-normalize-port b)))
1553 1513
1554(defun erc-generate-new-buffer-name (server port target &optional proc) 1514(defun erc-generate-new-buffer-name (server port target)
1555 "Create a new buffer name based on the arguments." 1515 "Create a new buffer name based on the arguments."
1556 (when (numberp port) (setq port (number-to-string port))) 1516 (when (numberp port) (setq port (number-to-string port)))
1557 (let ((buf-name (or target 1517 (let ((buf-name (or target
@@ -1582,9 +1542,9 @@ symbol, it may have these values:
1582 ;; fallback to the old <N> uniquification method: 1542 ;; fallback to the old <N> uniquification method:
1583 (or buffer-name (generate-new-buffer-name buf-name)) )) 1543 (or buffer-name (generate-new-buffer-name buf-name)) ))
1584 1544
1585(defun erc-get-buffer-create (server port target &optional proc) 1545(defun erc-get-buffer-create (server port target)
1586 "Create a new buffer based on the arguments." 1546 "Create a new buffer based on the arguments."
1587 (get-buffer-create (erc-generate-new-buffer-name server port target proc))) 1547 (get-buffer-create (erc-generate-new-buffer-name server port target)))
1588 1548
1589 1549
1590(defun erc-member-ignore-case (string list) 1550(defun erc-member-ignore-case (string list)
@@ -1700,6 +1660,7 @@ nil."
1700(defvar iswitchb-temp-buflist) 1660(defvar iswitchb-temp-buflist)
1701(declare-function iswitchb-read-buffer "iswitchb" 1661(declare-function iswitchb-read-buffer "iswitchb"
1702 (prompt &optional default require-match start matches-set)) 1662 (prompt &optional default require-match start matches-set))
1663(defvar iswitchb-make-buflist-hook)
1703 1664
1704(defun erc-iswitchb (&optional arg) 1665(defun erc-iswitchb (&optional arg)
1705 "Use `iswitchb-read-buffer' to prompt for a ERC buffer to switch to. 1666 "Use `iswitchb-read-buffer' to prompt for a ERC buffer to switch to.
@@ -1906,29 +1867,29 @@ removed from the list will be disabled."
1906 1867
1907(defun erc-setup-buffer (buffer) 1868(defun erc-setup-buffer (buffer)
1908 "Consults `erc-join-buffer' to find out how to display `BUFFER'." 1869 "Consults `erc-join-buffer' to find out how to display `BUFFER'."
1909 (cond ((eq erc-join-buffer 'window) 1870 (pcase erc-join-buffer
1910 (if (active-minibuffer-window) 1871 (`window
1911 (display-buffer buffer) 1872 (if (active-minibuffer-window)
1912 (switch-to-buffer-other-window buffer))) 1873 (display-buffer buffer)
1913 ((eq erc-join-buffer 'window-noselect) 1874 (switch-to-buffer-other-window buffer)))
1914 (display-buffer buffer)) 1875 (`window-noselect
1915 ((eq erc-join-buffer 'bury) 1876 (display-buffer buffer))
1916 nil) 1877 (`bury
1917 ((eq erc-join-buffer 'frame) 1878 nil)
1918 (when (or (not erc-reuse-frames) 1879 (`frame
1919 (not (get-buffer-window buffer t))) 1880 (when (or (not erc-reuse-frames)
1920 ((lambda (frame) 1881 (not (get-buffer-window buffer t)))
1921 (raise-frame frame) 1882 (let ((frame (make-frame (or erc-frame-alist
1922 (select-frame frame)) 1883 default-frame-alist))))
1923 (make-frame (or erc-frame-alist 1884 (raise-frame frame)
1924 default-frame-alist))) 1885 (select-frame frame))
1925 (switch-to-buffer buffer) 1886 (switch-to-buffer buffer)
1926 (when erc-frame-dedicated-flag 1887 (when erc-frame-dedicated-flag
1927 (set-window-dedicated-p (selected-window) t)))) 1888 (set-window-dedicated-p (selected-window) t))))
1928 (t 1889 (_
1929 (if (active-minibuffer-window) 1890 (if (active-minibuffer-window)
1930 (display-buffer buffer) 1891 (display-buffer buffer)
1931 (switch-to-buffer buffer))))) 1892 (switch-to-buffer buffer)))))
1932 1893
1933(defun erc-open (&optional server port nick full-name 1894(defun erc-open (&optional server port nick full-name
1934 connect passwd tgt-list channel process) 1895 connect passwd tgt-list channel process)
@@ -2006,19 +1967,20 @@ Returns the buffer for the given server or channel."
2006 ;; The local copy of `erc-nick' - the list of nicks to choose 1967 ;; The local copy of `erc-nick' - the list of nicks to choose
2007 (setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick))) 1968 (setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick)))
2008 ;; password stuff 1969 ;; password stuff
2009 (setq erc-session-password (or passwd 1970 (setq erc-session-password
2010 (let ((secret 1971 (or passwd
2011 (plist-get 1972 (let ((secret
2012 (nth 0 1973 (plist-get
2013 (auth-source-search :host server 1974 (nth 0
2014 :max 1 1975 (auth-source-search :host server
2015 :user nick 1976 :max 1
2016 :port port 1977 :user nick
2017 :require '(:secret))) 1978 :port port
2018 :secret))) 1979 :require '(:secret)))
2019 (if (functionp secret) 1980 :secret)))
2020 (funcall secret) 1981 (if (functionp secret)
2021 secret)))) 1982 (funcall secret)
1983 secret))))
2022 ;; debug output buffer 1984 ;; debug output buffer
2023 (setq erc-dbuf 1985 (setq erc-dbuf
2024 (when erc-log-p 1986 (when erc-log-p
@@ -2080,11 +2042,6 @@ If no buffer matches, return nil."
2080 (erc-port-equal erc-session-port port) 2042 (erc-port-equal erc-session-port port)
2081 (erc-current-nick-p nick))))) 2043 (erc-current-nick-p nick)))))
2082 2044
2083(if (not (fboundp 'read-passwd))
2084 (defun read-passwd (prompt)
2085 "Substitute for `read-passwd' in early emacsen."
2086 (read-from-minibuffer prompt)))
2087
2088(defcustom erc-before-connect nil 2045(defcustom erc-before-connect nil
2089 "Hook called before connecting to a server. 2046 "Hook called before connecting to a server.
2090This hook gets executed before `erc' actually invokes `erc-mode' 2047This hook gets executed before `erc' actually invokes `erc-mode'
@@ -2433,11 +2390,11 @@ If STRING is nil, the function does nothing."
2433 (t (list (current-buffer))))) 2390 (t (list (current-buffer)))))
2434 (when (buffer-live-p buf) 2391 (when (buffer-live-p buf)
2435 (erc-display-line-1 string buf) 2392 (erc-display-line-1 string buf)
2436 (add-to-list 'new-bufs buf))) 2393 (push buf new-bufs)))
2437 (when (null new-bufs) 2394 (when (null new-bufs)
2438 (if (erc-server-buffer-live-p) 2395 (erc-display-line-1 string (if (erc-server-buffer-live-p)
2439 (erc-display-line-1 string (process-buffer erc-server-process)) 2396 (process-buffer erc-server-process)
2440 (erc-display-line-1 string (current-buffer)))))) 2397 (current-buffer))))))
2441 2398
2442(defun erc-display-message-highlight (type string) 2399(defun erc-display-message-highlight (type string)
2443 "Highlight STRING according to TYPE, where erc-TYPE-face is an ERC face. 2400 "Highlight STRING according to TYPE, where erc-TYPE-face is an ERC face.
@@ -2544,7 +2501,7 @@ consumption for long-lived IRC or Emacs sessions."
2544 "Internal counter variable for use with `erc-lurker-cleanup-interval'.") 2501 "Internal counter variable for use with `erc-lurker-cleanup-interval'.")
2545 2502
2546(defvar erc-lurker-cleanup-interval 100 2503(defvar erc-lurker-cleanup-interval 100
2547 "Specifies frequency of cleaning up stale erc-lurker state. 2504 "Frequency of cleaning up stale erc-lurker state.
2548 2505
2549`erc-lurker-update-status' calls `erc-lurker-cleanup' once for 2506`erc-lurker-update-status' calls `erc-lurker-cleanup' once for
2550every `erc-lurker-cleanup-interval' updates to 2507every `erc-lurker-cleanup-interval' updates to
@@ -2552,7 +2509,7 @@ every `erc-lurker-cleanup-interval' updates to
2552consumption of lurker state during long Emacs sessions and/or ERC 2509consumption of lurker state during long Emacs sessions and/or ERC
2553sessions with large numbers of incoming PRIVMSGs.") 2510sessions with large numbers of incoming PRIVMSGs.")
2554 2511
2555(defun erc-lurker-update-status (message) 2512(defun erc-lurker-update-status (_message)
2556 "Update `erc-lurker-state' if necessary. 2513 "Update `erc-lurker-state' if necessary.
2557 2514
2558This function is called from `erc-insert-pre-hook'. If the 2515This function is called from `erc-insert-pre-hook'. If the
@@ -2614,7 +2571,7 @@ displayed hostnames."
2614 :type 'alist) 2571 :type 'alist)
2615 2572
2616(defun erc-canonicalize-server-name (server) 2573(defun erc-canonicalize-server-name (server)
2617 "Returns the canonical network name for SERVER if any, 2574 "Return the canonical network name for SERVER if any,
2618otherwise `erc-server-announced-name'. SERVER is matched against 2575otherwise `erc-server-announced-name'. SERVER is matched against
2619`erc-common-server-suffixes'." 2576`erc-common-server-suffixes'."
2620 (when server 2577 (when server
@@ -2877,7 +2834,7 @@ If no USER argument is specified, list the contents of `erc-ignore-list'."
2877 (interactive) 2834 (interactive)
2878 (let ((ops nil)) 2835 (let ((ops nil))
2879 (if erc-channel-users 2836 (if erc-channel-users
2880 (maphash (lambda (nick user-data) 2837 (maphash (lambda (_nick user-data)
2881 (let ((cuser (cdr user-data))) 2838 (let ((cuser (cdr user-data)))
2882 (if (and cuser 2839 (if (and cuser
2883 (erc-channel-user-op cuser)) 2840 (erc-channel-user-op cuser))
@@ -3007,9 +2964,9 @@ were most recently invited. See also `invitation'."
3007 (switch-to-buffer (car (erc-member-ignore-case chnl 2964 (switch-to-buffer (car (erc-member-ignore-case chnl
3008 joined-channels))) 2965 joined-channels)))
3009 (erc-log (format "cmd: JOIN: %s" chnl)) 2966 (erc-log (format "cmd: JOIN: %s" chnl))
3010 (if (and chnl key) 2967 (erc-server-send (if (and chnl key)
3011 (erc-server-send (format "JOIN %s %s" chnl key)) 2968 (format "JOIN %s %s" chnl key)
3012 (erc-server-send (format "JOIN %s" chnl))))))) 2969 (format "JOIN %s" chnl)))))))
3013 t) 2970 t)
3014 2971
3015(defalias 'erc-cmd-CHANNEL 'erc-cmd-JOIN) 2972(defalias 'erc-cmd-CHANNEL 'erc-cmd-JOIN)
@@ -3120,68 +3077,76 @@ If SERVER is non-nil, use that, rather than the current server."
3120 (let ((origbuf (current-buffer)) 3077 (let ((origbuf (current-buffer))
3121 symlist) 3078 symlist)
3122 (erc-with-server-buffer 3079 (erc-with-server-buffer
3123 (add-to-list 'symlist 3080 (push (cons (erc-once-with-server-event
3124 (cons (erc-once-with-server-event 3081 311 (lambda (_proc parsed)
3125 311 `(string= ,nick 3082 (string= nick
3126 (nth 1 3083 (nth 1 (erc-response.command-args
3127 (erc-response.command-args parsed)))) 3084 parsed)))))
3128 'erc-server-311-functions)) 3085 'erc-server-311-functions)
3129 (add-to-list 'symlist 3086 symlist)
3130 (cons (erc-once-with-server-event 3087 (push (cons (erc-once-with-server-event
3131 312 `(string= ,nick 3088 312 (lambda (_proc parsed)
3132 (nth 1 3089 (string= nick
3133 (erc-response.command-args parsed)))) 3090 (nth 1 (erc-response.command-args
3134 'erc-server-312-functions)) 3091 parsed)))))
3135 (add-to-list 'symlist 3092 'erc-server-312-functions)
3136 (cons (erc-once-with-server-event 3093 symlist)
3137 318 `(string= ,nick 3094 (push (cons (erc-once-with-server-event
3138 (nth 1 3095 318 (lambda (_proc parsed)
3139 (erc-response.command-args parsed)))) 3096 (string= nick
3140 'erc-server-318-functions)) 3097 (nth 1 (erc-response.command-args
3141 (add-to-list 'symlist 3098 parsed)))))
3142 (cons (erc-once-with-server-event 3099 'erc-server-318-functions)
3143 319 `(string= ,nick 3100 symlist)
3144 (nth 1 3101 (push (cons (erc-once-with-server-event
3145 (erc-response.command-args parsed)))) 3102 319 (lambda (_proc parsed)
3146 'erc-server-319-functions)) 3103 (string= nick
3147 (add-to-list 'symlist 3104 (nth 1 (erc-response.command-args
3148 (cons (erc-once-with-server-event 3105 parsed)))))
3149 320 `(string= ,nick 3106 'erc-server-319-functions)
3150 (nth 1 3107 symlist)
3151 (erc-response.command-args parsed)))) 3108 (push (cons (erc-once-with-server-event
3152 'erc-server-320-functions)) 3109 320 (lambda (_proc parsed)
3153 (add-to-list 'symlist 3110 (string= nick
3154 (cons (erc-once-with-server-event 3111 (nth 1 (erc-response.command-args
3155 330 `(string= ,nick 3112 parsed)))))
3156 (nth 1 3113 'erc-server-320-functions)
3157 (erc-response.command-args parsed)))) 3114 symlist)
3158 'erc-server-330-functions)) 3115 (push (cons (erc-once-with-server-event
3159 (add-to-list 'symlist 3116 330 (lambda (_proc parsed)
3160 (cons (erc-once-with-server-event 3117 (string= nick
3161 317 3118 (nth 1 (erc-response.command-args
3162 `(let ((idleseconds 3119 parsed)))))
3163 (string-to-number 3120 'erc-server-330-functions)
3164 (third 3121 symlist)
3165 (erc-response.command-args parsed))))) 3122 (push (cons (erc-once-with-server-event
3166 (erc-display-line 3123 317
3167 (erc-make-notice 3124 (lambda (_proc parsed)
3168 (format "%s has been idle for %s." 3125 (let ((idleseconds
3169 (erc-string-no-properties ,nick) 3126 (string-to-number
3170 (erc-seconds-to-string idleseconds))) 3127 (cl-third
3171 ,origbuf)) 3128 (erc-response.command-args parsed)))))
3172 t) 3129 (erc-display-line
3173 'erc-server-317-functions)) 3130 (erc-make-notice
3174 3131 (format "%s has been idle for %s."
3175 ;; Send the WHOIS command. 3132 (erc-string-no-properties nick)
3176 (erc-cmd-WHOIS nick) 3133 (erc-seconds-to-string idleseconds)))
3177 3134 origbuf)
3178 ;; Remove the uninterned symbols from the server hooks that did not run. 3135 t)))
3179 (run-at-time 20 nil `(lambda () 3136 'erc-server-317-functions)
3180 (with-current-buffer ,(current-buffer) 3137 symlist)
3181 (dolist (sym ',symlist) 3138
3182 (let ((hooksym (cdr sym)) 3139 ;; Send the WHOIS command.
3183 (funcsym (car sym))) 3140 (erc-cmd-WHOIS nick)
3184 (remove-hook hooksym funcsym t)))))))) 3141
3142 ;; Remove the uninterned symbols from the server hooks that did not run.
3143 (run-at-time 20 nil (lambda (buf symlist)
3144 (with-current-buffer buf
3145 (dolist (sym symlist)
3146 (let ((hooksym (cdr sym))
3147 (funcsym (car sym)))
3148 (remove-hook hooksym funcsym t)))))
3149 (current-buffer) symlist)))
3185 t) 3150 t)
3186 3151
3187(defun erc-cmd-DESCRIBE (line) 3152(defun erc-cmd-DESCRIBE (line)
@@ -3690,11 +3655,12 @@ The ban list is fetched from the server if necessary."
3690 (erc-with-server-buffer 3655 (erc-with-server-buffer
3691 (erc-once-with-server-event 3656 (erc-once-with-server-event
3692 368 3657 368
3693 `(with-current-buffer ,chnl-name 3658 (lambda (_proc _parsed)
3659 (with-current-buffer chnl-name
3694 (put 'erc-channel-banlist 'received-from-server t) 3660 (put 'erc-channel-banlist 'received-from-server t)
3695 (setq erc-server-367-functions ',old-367-hook) 3661 (setq erc-server-367-functions old-367-hook)
3696 (erc-cmd-BANLIST) 3662 (erc-cmd-BANLIST)
3697 t)) 3663 t)))
3698 (erc-server-send (format "MODE %s b" chnl))))) 3664 (erc-server-send (format "MODE %s b" chnl)))))
3699 3665
3700 ((null erc-channel-banlist) 3666 ((null erc-channel-banlist)
@@ -3756,28 +3722,29 @@ Unban all currently banned users in the current channel."
3756 ((not (get 'erc-channel-banlist 'received-from-server)) 3722 ((not (get 'erc-channel-banlist 'received-from-server))
3757 (let ((old-367-hook erc-server-367-functions)) 3723 (let ((old-367-hook erc-server-367-functions))
3758 (setq erc-server-367-functions 'erc-banlist-store) 3724 (setq erc-server-367-functions 'erc-banlist-store)
3759 ;; fetch the ban list then callback 3725 ;; fetch the ban list then callback
3760 (erc-with-server-buffer 3726 (erc-with-server-buffer
3761 (erc-once-with-server-event 3727 (erc-once-with-server-event
3762 368 3728 368
3763 `(with-current-buffer ,chnl 3729 (lambda (_proc _parsed)
3764 (put 'erc-channel-banlist 'received-from-server t) 3730 (with-current-buffer chnl
3765 (setq erc-server-367-functions ,old-367-hook) 3731 (put 'erc-channel-banlist 'received-from-server t)
3766 (erc-cmd-MASSUNBAN) 3732 (setq erc-server-367-functions old-367-hook)
3767 t)) 3733 (erc-cmd-MASSUNBAN)
3768 (erc-server-send (format "MODE %s b" chnl))))) 3734 t)))
3735 (erc-server-send (format "MODE %s b" chnl)))))
3769 3736
3770 (t (let ((bans (mapcar 'cdr erc-channel-banlist))) 3737 (t (let ((bans (mapcar 'cdr erc-channel-banlist)))
3771 (when bans 3738 (when bans
3772 ;; Glob the bans into groups of three, and carry out the unban. 3739 ;; Glob the bans into groups of three, and carry out the unban.
3773 ;; eg. /mode #foo -bbb a*!*@* b*!*@* c*!*@* 3740 ;; eg. /mode #foo -bbb a*!*@* b*!*@* c*!*@*
3774 (mapc 3741 (mapc
3775 (lambda (x) 3742 (lambda (x)
3776 (erc-server-send 3743 (erc-server-send
3777 (format "MODE %s -%s %s" (erc-default-target) 3744 (format "MODE %s -%s %s" (erc-default-target)
3778 (make-string (length x) ?b) 3745 (make-string (length x) ?b)
3779 (mapconcat 'identity x " ")))) 3746 (mapconcat 'identity x " "))))
3780 (erc-group-list bans 3)))) 3747 (erc-group-list bans 3))))
3781 t)))) 3748 t))))
3782 3749
3783(defalias 'erc-cmd-MUB 'erc-cmd-MASSUNBAN) 3750(defalias 'erc-cmd-MUB 'erc-cmd-MASSUNBAN)
@@ -3933,9 +3900,9 @@ Prompt for one if called interactively."
3933 (format "Limit for %s (RET to remove limit): " 3900 (format "Limit for %s (RET to remove limit): "
3934 (erc-default-target))))) 3901 (erc-default-target)))))
3935 (let ((tgt (erc-default-target))) 3902 (let ((tgt (erc-default-target)))
3936 (if (and limit (>= (length limit) 1)) 3903 (erc-server-send (if (and limit (>= (length limit) 1))
3937 (erc-server-send (format "MODE %s +l %s" tgt limit)) 3904 (format "MODE %s +l %s" tgt limit)
3938 (erc-server-send (format "MODE %s -l" tgt))))) 3905 (format "MODE %s -l" tgt)))))
3939 3906
3940(defun erc-set-channel-key (&optional key) 3907(defun erc-set-channel-key (&optional key)
3941 "Set a KEY for the current channel. Remove key if nil. 3908 "Set a KEY for the current channel. Remove key if nil.
@@ -3944,9 +3911,9 @@ Prompt for one if called interactively."
3944 (format "Key for %s (RET to remove key): " 3911 (format "Key for %s (RET to remove key): "
3945 (erc-default-target))))) 3912 (erc-default-target)))))
3946 (let ((tgt (erc-default-target))) 3913 (let ((tgt (erc-default-target)))
3947 (if (and key (>= (length key) 1)) 3914 (erc-server-send (if (and key (>= (length key) 1))
3948 (erc-server-send (format "MODE %s +k %s" tgt key)) 3915 (format "MODE %s +k %s" tgt key)
3949 (erc-server-send (format "MODE %s -k" tgt))))) 3916 (format "MODE %s -k" tgt)))))
3950 3917
3951(defun erc-quit-server (reason) 3918(defun erc-quit-server (reason)
3952 "Disconnect from current server after prompting for REASON. 3919 "Disconnect from current server after prompting for REASON.
@@ -4023,7 +3990,7 @@ Displays PROC and PARSED appropriately using `erc-display-message'."
4023See `erc-debug-missing-hooks'.") 3990See `erc-debug-missing-hooks'.")
4024;(make-variable-buffer-local 'erc-server-vectors) 3991;(make-variable-buffer-local 'erc-server-vectors)
4025 3992
4026(defun erc-debug-missing-hooks (proc parsed) 3993(defun erc-debug-missing-hooks (_proc parsed)
4027 "Add PARSED server message ERC does not yet handle to `erc-server-vectors'. 3994 "Add PARSED server message ERC does not yet handle to `erc-server-vectors'.
4028These vectors can be helpful when adding new server message handlers to ERC. 3995These vectors can be helpful when adding new server message handlers to ERC.
4029See `erc-default-server-hook'." 3996See `erc-default-server-hook'."
@@ -4163,7 +4130,7 @@ originated from,
4163and as second argument the event parsed as a vector." 4130and as second argument the event parsed as a vector."
4164 :group 'erc-hooks) 4131 :group 'erc-hooks)
4165 4132
4166(defun erc-display-server-message (proc parsed) 4133(defun erc-display-server-message (_proc parsed)
4167 "Display the message sent by the server as a notice." 4134 "Display the message sent by the server as a notice."
4168 (erc-display-message 4135 (erc-display-message
4169 parsed 'notice 'active (erc-response.contents parsed))) 4136 parsed 'notice 'active (erc-response.contents parsed)))
@@ -4219,7 +4186,7 @@ and as second argument the event parsed as a vector."
4219 :group 'erc-display 4186 :group 'erc-display
4220 :type 'function) 4187 :type 'function)
4221 4188
4222(defun erc-format-nick (&optional user channel-data) 4189(defun erc-format-nick (&optional user _channel-data)
4223 "Return the nickname of USER. 4190 "Return the nickname of USER.
4224See also `erc-format-nick-function'." 4191See also `erc-format-nick-function'."
4225 (when user (erc-server-user-nickname user))) 4192 (when user (erc-server-user-nickname user)))
@@ -4247,7 +4214,7 @@ See also `erc-format-nick-function'."
4247 (let ((prefix "> ")) 4214 (let ((prefix "> "))
4248 (erc-propertize prefix 'face 'erc-default-face)))) 4215 (erc-propertize prefix 'face 'erc-default-face))))
4249 4216
4250(defun erc-echo-notice-in-default-buffer (s parsed buffer sender) 4217(defun erc-echo-notice-in-default-buffer (s parsed buffer _sender)
4251 "Echos a private notice in the default buffer, namely the 4218 "Echos a private notice in the default buffer, namely the
4252target buffer specified by BUFFER, or there is no target buffer, 4219target buffer specified by BUFFER, or there is no target buffer,
4253the server buffer. This function is designed to be added to 4220the server buffer. This function is designed to be added to
@@ -4256,7 +4223,7 @@ and always returns t."
4256 (erc-display-message parsed nil buffer s) 4223 (erc-display-message parsed nil buffer s)
4257 t) 4224 t)
4258 4225
4259(defun erc-echo-notice-in-target-buffer (s parsed buffer sender) 4226(defun erc-echo-notice-in-target-buffer (s parsed buffer _sender)
4260 "Echos a private notice in BUFFER, if BUFFER is non-nil. This 4227 "Echos a private notice in BUFFER, if BUFFER is non-nil. This
4261function is designed to be added to either `erc-echo-notice-hook' 4228function is designed to be added to either `erc-echo-notice-hook'
4262or `erc-echo-notice-always-hook', and returns non-nil if BUFFER 4229or `erc-echo-notice-always-hook', and returns non-nil if BUFFER
@@ -4265,21 +4232,21 @@ is non-nil."
4265 (progn (erc-display-message parsed nil buffer s) t) 4232 (progn (erc-display-message parsed nil buffer s) t)
4266 nil)) 4233 nil))
4267 4234
4268(defun erc-echo-notice-in-minibuffer (s parsed buffer sender) 4235(defun erc-echo-notice-in-minibuffer (s _parsed _buffer _sender)
4269 "Echos a private notice in the minibuffer. This function is 4236 "Echos a private notice in the minibuffer. This function is
4270designed to be added to either `erc-echo-notice-hook' or 4237designed to be added to either `erc-echo-notice-hook' or
4271`erc-echo-notice-always-hook', and always returns t." 4238`erc-echo-notice-always-hook', and always returns t."
4272 (message "%s" (concat "NOTICE: " s)) 4239 (message "%s" (concat "NOTICE: " s))
4273 t) 4240 t)
4274 4241
4275(defun erc-echo-notice-in-server-buffer (s parsed buffer sender) 4242(defun erc-echo-notice-in-server-buffer (s parsed _buffer _sender)
4276 "Echos a private notice in the server buffer. This function is 4243 "Echos a private notice in the server buffer. This function is
4277designed to be added to either `erc-echo-notice-hook' or 4244designed to be added to either `erc-echo-notice-hook' or
4278`erc-echo-notice-always-hook', and always returns t." 4245`erc-echo-notice-always-hook', and always returns t."
4279 (erc-display-message parsed nil nil s) 4246 (erc-display-message parsed nil nil s)
4280 t) 4247 t)
4281 4248
4282(defun erc-echo-notice-in-active-non-server-buffer (s parsed buffer sender) 4249(defun erc-echo-notice-in-active-non-server-buffer (s parsed _buffer _sender)
4283 "Echos a private notice in the active buffer if the active 4250 "Echos a private notice in the active buffer if the active
4284buffer is not the server buffer. This function is designed to be 4251buffer is not the server buffer. This function is designed to be
4285added to either `erc-echo-notice-hook' or 4252added to either `erc-echo-notice-hook' or
@@ -4289,14 +4256,14 @@ buffer is not the server buffer."
4289 (progn (erc-display-message parsed nil 'active s) t) 4256 (progn (erc-display-message parsed nil 'active s) t)
4290 nil)) 4257 nil))
4291 4258
4292(defun erc-echo-notice-in-active-buffer (s parsed buffer sender) 4259(defun erc-echo-notice-in-active-buffer (s parsed _buffer _sender)
4293 "Echos a private notice in the active buffer. This function is 4260 "Echos a private notice in the active buffer. This function is
4294designed to be added to either `erc-echo-notice-hook' or 4261designed to be added to either `erc-echo-notice-hook' or
4295`erc-echo-notice-always-hook', and always returns t." 4262`erc-echo-notice-always-hook', and always returns t."
4296 (erc-display-message parsed nil 'active s) 4263 (erc-display-message parsed nil 'active s)
4297 t) 4264 t)
4298 4265
4299(defun erc-echo-notice-in-user-buffers (s parsed buffer sender) 4266(defun erc-echo-notice-in-user-buffers (s parsed _buffer sender)
4300 "Echos a private notice in all of the buffers for which SENDER 4267 "Echos a private notice in all of the buffers for which SENDER
4301is a member. This function is designed to be added to either 4268is a member. This function is designed to be added to either
4302`erc-echo-notice-hook' or `erc-echo-notice-always-hook', and 4269`erc-echo-notice-hook' or `erc-echo-notice-always-hook', and
@@ -4321,12 +4288,12 @@ default target.
4321See also: `erc-echo-notice-in-user-buffers', 4288See also: `erc-echo-notice-in-user-buffers',
4322`erc-buffer-list-with-nick'." 4289`erc-buffer-list-with-nick'."
4323 (let ((buffers (erc-buffer-list-with-nick sender erc-server-process))) 4290 (let ((buffers (erc-buffer-list-with-nick sender erc-server-process)))
4324 (add-to-list 'buffers buffer) 4291 (unless (memq buffer buffers) (push buffer buffers))
4325 (if buffers 4292 (if buffers ;FIXME: How could it be nil?
4326 (progn (erc-display-message parsed nil buffers s) t) 4293 (progn (erc-display-message parsed nil buffers s) t)
4327 nil))) 4294 nil)))
4328 4295
4329(defun erc-echo-notice-in-first-user-buffer (s parsed buffer sender) 4296(defun erc-echo-notice-in-first-user-buffer (s parsed _buffer sender)
4330 "Echos a private notice in one of the buffers for which SENDER 4297 "Echos a private notice in one of the buffers for which SENDER
4331is a member. This function is designed to be added to either 4298is a member. This function is designed to be added to either
4332`erc-echo-notice-hook' or `erc-echo-notice-always-hook', and 4299`erc-echo-notice-hook' or `erc-echo-notice-always-hook', and
@@ -4504,7 +4471,7 @@ See also `erc-display-message'."
4504 4471
4505(defvar erc-ctcp-query-CLIENTINFO-hook '(erc-ctcp-query-CLIENTINFO)) 4472(defvar erc-ctcp-query-CLIENTINFO-hook '(erc-ctcp-query-CLIENTINFO))
4506 4473
4507(defun erc-ctcp-query-CLIENTINFO (proc nick login host to msg) 4474(defun erc-ctcp-query-CLIENTINFO (_proc nick _login _host _to msg)
4508 "Respond to a CTCP CLIENTINFO query." 4475 "Respond to a CTCP CLIENTINFO query."
4509 (when (string-match "^CLIENTINFO\\(\\s-*\\|\\s-+.*\\)$" msg) 4476 (when (string-match "^CLIENTINFO\\(\\s-*\\|\\s-+.*\\)$" msg)
4510 (let ((s (erc-client-info (erc-trim-string (match-string 1 msg))))) 4477 (let ((s (erc-client-info (erc-trim-string (match-string 1 msg)))))
@@ -4513,7 +4480,7 @@ See also `erc-display-message'."
4513 nil) 4480 nil)
4514 4481
4515(defvar erc-ctcp-query-ECHO-hook '(erc-ctcp-query-ECHO)) 4482(defvar erc-ctcp-query-ECHO-hook '(erc-ctcp-query-ECHO))
4516(defun erc-ctcp-query-ECHO (proc nick login host to msg) 4483(defun erc-ctcp-query-ECHO (_proc nick _login _host _to msg)
4517 "Respond to a CTCP ECHO query." 4484 "Respond to a CTCP ECHO query."
4518 (when (string-match "^ECHO\\s-+\\(.*\\)\\s-*$" msg) 4485 (when (string-match "^ECHO\\s-+\\(.*\\)\\s-*$" msg)
4519 (let ((s (match-string 1 msg))) 4486 (let ((s (match-string 1 msg)))
@@ -4522,7 +4489,7 @@ See also `erc-display-message'."
4522 nil) 4489 nil)
4523 4490
4524(defvar erc-ctcp-query-FINGER-hook '(erc-ctcp-query-FINGER)) 4491(defvar erc-ctcp-query-FINGER-hook '(erc-ctcp-query-FINGER))
4525(defun erc-ctcp-query-FINGER (proc nick login host to msg) 4492(defun erc-ctcp-query-FINGER (_proc nick _login _host _to _msg)
4526 "Respond to a CTCP FINGER query." 4493 "Respond to a CTCP FINGER query."
4527 (unless erc-disable-ctcp-replies 4494 (unless erc-disable-ctcp-replies
4528 (let ((s (if erc-anonymous-login 4495 (let ((s (if erc-anonymous-login
@@ -4538,7 +4505,7 @@ See also `erc-display-message'."
4538 nil) 4505 nil)
4539 4506
4540(defvar erc-ctcp-query-PING-hook '(erc-ctcp-query-PING)) 4507(defvar erc-ctcp-query-PING-hook '(erc-ctcp-query-PING))
4541(defun erc-ctcp-query-PING (proc nick login host to msg) 4508(defun erc-ctcp-query-PING (_proc nick _login _host _to msg)
4542 "Respond to a CTCP PING query." 4509 "Respond to a CTCP PING query."
4543 (when (string-match "^PING\\s-+\\(.*\\)" msg) 4510 (when (string-match "^PING\\s-+\\(.*\\)" msg)
4544 (unless erc-disable-ctcp-replies 4511 (unless erc-disable-ctcp-replies
@@ -4547,21 +4514,21 @@ See also `erc-display-message'."
4547 nil) 4514 nil)
4548 4515
4549(defvar erc-ctcp-query-TIME-hook '(erc-ctcp-query-TIME)) 4516(defvar erc-ctcp-query-TIME-hook '(erc-ctcp-query-TIME))
4550(defun erc-ctcp-query-TIME (proc nick login host to msg) 4517(defun erc-ctcp-query-TIME (_proc nick _login _host _to _msg)
4551 "Respond to a CTCP TIME query." 4518 "Respond to a CTCP TIME query."
4552 (unless erc-disable-ctcp-replies 4519 (unless erc-disable-ctcp-replies
4553 (erc-send-ctcp-notice nick (format "TIME %s" (current-time-string)))) 4520 (erc-send-ctcp-notice nick (format "TIME %s" (current-time-string))))
4554 nil) 4521 nil)
4555 4522
4556(defvar erc-ctcp-query-USERINFO-hook '(erc-ctcp-query-USERINFO)) 4523(defvar erc-ctcp-query-USERINFO-hook '(erc-ctcp-query-USERINFO))
4557(defun erc-ctcp-query-USERINFO (proc nick login host to msg) 4524(defun erc-ctcp-query-USERINFO (_proc nick _login _host _to _msg)
4558 "Respond to a CTCP USERINFO query." 4525 "Respond to a CTCP USERINFO query."
4559 (unless erc-disable-ctcp-replies 4526 (unless erc-disable-ctcp-replies
4560 (erc-send-ctcp-notice nick (format "USERINFO %s" erc-user-information))) 4527 (erc-send-ctcp-notice nick (format "USERINFO %s" erc-user-information)))
4561 nil) 4528 nil)
4562 4529
4563(defvar erc-ctcp-query-VERSION-hook '(erc-ctcp-query-VERSION)) 4530(defvar erc-ctcp-query-VERSION-hook '(erc-ctcp-query-VERSION))
4564(defun erc-ctcp-query-VERSION (proc nick login host to msg) 4531(defun erc-ctcp-query-VERSION (_proc nick _login _host _to _msg)
4565 "Respond to a CTCP VERSION query." 4532 "Respond to a CTCP VERSION query."
4566 (unless erc-disable-ctcp-replies 4533 (unless erc-disable-ctcp-replies
4567 (erc-send-ctcp-notice 4534 (erc-send-ctcp-notice
@@ -4584,7 +4551,7 @@ See also `erc-display-message'."
4584 'CTCP-UNKNOWN ?n nick ?u login ?h host ?m msg)))) 4551 'CTCP-UNKNOWN ?n nick ?u login ?h host ?m msg))))
4585 4552
4586(defvar erc-ctcp-reply-ECHO-hook '(erc-ctcp-reply-ECHO)) 4553(defvar erc-ctcp-reply-ECHO-hook '(erc-ctcp-reply-ECHO))
4587(defun erc-ctcp-reply-ECHO (proc nick login host to msg) 4554(defun erc-ctcp-reply-ECHO (_proc nick _login _host _to msg)
4588 "Handle a CTCP ECHO reply." 4555 "Handle a CTCP ECHO reply."
4589 (when (string-match "^ECHO\\s-+\\(.*\\)\\s-*$" msg) 4556 (when (string-match "^ECHO\\s-+\\(.*\\)\\s-*$" msg)
4590 (let ((message (match-string 1 msg))) 4557 (let ((message (match-string 1 msg)))
@@ -4594,7 +4561,7 @@ See also `erc-display-message'."
4594 nil) 4561 nil)
4595 4562
4596(defvar erc-ctcp-reply-CLIENTINFO-hook '(erc-ctcp-reply-CLIENTINFO)) 4563(defvar erc-ctcp-reply-CLIENTINFO-hook '(erc-ctcp-reply-CLIENTINFO))
4597(defun erc-ctcp-reply-CLIENTINFO (proc nick login host to msg) 4564(defun erc-ctcp-reply-CLIENTINFO (_proc nick _login _host _to msg)
4598 "Handle a CTCP CLIENTINFO reply." 4565 "Handle a CTCP CLIENTINFO reply."
4599 (when (string-match "^CLIENTINFO\\s-+\\(.*\\)\\s-*$" msg) 4566 (when (string-match "^CLIENTINFO\\s-+\\(.*\\)\\s-*$" msg)
4600 (let ((message (match-string 1 msg))) 4567 (let ((message (match-string 1 msg)))
@@ -4604,7 +4571,7 @@ See also `erc-display-message'."
4604 nil) 4571 nil)
4605 4572
4606(defvar erc-ctcp-reply-FINGER-hook '(erc-ctcp-reply-FINGER)) 4573(defvar erc-ctcp-reply-FINGER-hook '(erc-ctcp-reply-FINGER))
4607(defun erc-ctcp-reply-FINGER (proc nick login host to msg) 4574(defun erc-ctcp-reply-FINGER (_proc nick _login _host _to msg)
4608 "Handle a CTCP FINGER reply." 4575 "Handle a CTCP FINGER reply."
4609 (when (string-match "^FINGER\\s-+\\(.*\\)\\s-*$" msg) 4576 (when (string-match "^FINGER\\s-+\\(.*\\)\\s-*$" msg)
4610 (let ((message (match-string 1 msg))) 4577 (let ((message (match-string 1 msg)))
@@ -4614,7 +4581,7 @@ See also `erc-display-message'."
4614 nil) 4581 nil)
4615 4582
4616(defvar erc-ctcp-reply-PING-hook '(erc-ctcp-reply-PING)) 4583(defvar erc-ctcp-reply-PING-hook '(erc-ctcp-reply-PING))
4617(defun erc-ctcp-reply-PING (proc nick login host to msg) 4584(defun erc-ctcp-reply-PING (_proc nick _login _host _to msg)
4618 "Handle a CTCP PING reply." 4585 "Handle a CTCP PING reply."
4619 (if (not (string-match "^PING\\s-+\\([0-9.]+\\)" msg)) 4586 (if (not (string-match "^PING\\s-+\\([0-9.]+\\)" msg))
4620 nil 4587 nil
@@ -4632,7 +4599,7 @@ See also `erc-display-message'."
4632 'bad-ping-response ?n nick ?t time)))))) 4599 'bad-ping-response ?n nick ?t time))))))
4633 4600
4634(defvar erc-ctcp-reply-TIME-hook '(erc-ctcp-reply-TIME)) 4601(defvar erc-ctcp-reply-TIME-hook '(erc-ctcp-reply-TIME))
4635(defun erc-ctcp-reply-TIME (proc nick login host to msg) 4602(defun erc-ctcp-reply-TIME (_proc nick _login _host _to msg)
4636 "Handle a CTCP TIME reply." 4603 "Handle a CTCP TIME reply."
4637 (when (string-match "^TIME\\s-+\\(.*\\)\\s-*$" msg) 4604 (when (string-match "^TIME\\s-+\\(.*\\)\\s-*$" msg)
4638 (let ((message (match-string 1 msg))) 4605 (let ((message (match-string 1 msg)))
@@ -4642,7 +4609,7 @@ See also `erc-display-message'."
4642 nil) 4609 nil)
4643 4610
4644(defvar erc-ctcp-reply-VERSION-hook '(erc-ctcp-reply-VERSION)) 4611(defvar erc-ctcp-reply-VERSION-hook '(erc-ctcp-reply-VERSION))
4645(defun erc-ctcp-reply-VERSION (proc nick login host to msg) 4612(defun erc-ctcp-reply-VERSION (_proc nick _login _host _to msg)
4646 "Handle a CTCP VERSION reply." 4613 "Handle a CTCP VERSION reply."
4647 (when (string-match "^VERSION\\s-+\\(.*\\)\\s-*$" msg) 4614 (when (string-match "^VERSION\\s-+\\(.*\\)\\s-*$" msg)
4648 (let ((message (match-string 1 msg))) 4615 (let ((message (match-string 1 msg)))
@@ -4705,7 +4672,7 @@ received. Should be called with the current buffer set to the
4705channel buffer. 4672channel buffer.
4706 4673
4707See also `erc-channel-begin-receiving-names'." 4674See also `erc-channel-begin-receiving-names'."
4708 (maphash (lambda (nick user) 4675 (maphash (lambda (nick _user)
4709 (if (null (gethash nick erc-channel-new-member-names)) 4676 (if (null (gethash nick erc-channel-new-member-names))
4710 (erc-remove-channel-user nick))) 4677 (erc-remove-channel-user nick)))
4711 erc-channel-users) 4678 erc-channel-users)
@@ -4746,8 +4713,7 @@ channel."
4746 (setq names (delete "" (split-string names-string))) 4713 (setq names (delete "" (split-string names-string)))
4747 (let ((erc-channel-members-changed-hook nil)) 4714 (let ((erc-channel-members-changed-hook nil))
4748 (dolist (item names) 4715 (dolist (item names)
4749 (let ((updatep t) 4716 (let ((updatep t))
4750 ch)
4751 (if (rassq (elt item 0) prefix) 4717 (if (rassq (elt item 0) prefix)
4752 (cond ((= (length item) 1) 4718 (cond ((= (length item) 1)
4753 (setq updatep nil)) 4719 (setq updatep nil))
@@ -4780,8 +4746,7 @@ The buffer where the change happened is current while this hook is called."
4780 4746
4781(defun erc-update-user-nick (nick &optional new-nick 4747(defun erc-update-user-nick (nick &optional new-nick
4782 host login full-name info) 4748 host login full-name info)
4783 "Updates the stored user information for the user with nickname 4749 "Update the stored user information for the user with nickname NICK.
4784NICK.
4785 4750
4786See also: `erc-update-user'." 4751See also: `erc-update-user'."
4787 (erc-update-user (erc-get-server-user nick) new-nick 4752 (erc-update-user (erc-get-server-user nick) new-nick
@@ -4831,8 +4796,8 @@ which USER is a member, and t is returned."
4831(defun erc-update-current-channel-member 4796(defun erc-update-current-channel-member
4832 (nick new-nick &optional add op voice host login full-name info 4797 (nick new-nick &optional add op voice host login full-name info
4833 update-message-time) 4798 update-message-time)
4834 "Updates the stored user information for the user with nickname 4799 "Update the stored user information for the user with nickname NICK.
4835NICK. `erc-update-user' is called to handle changes to nickname, 4800`erc-update-user' is called to handle changes to nickname,
4836HOST, LOGIN, FULL-NAME, and INFO. If OP or VOICE are non-nil, 4801HOST, LOGIN, FULL-NAME, and INFO. If OP or VOICE are non-nil,
4837they must be equal to either `on' or `off', in which case the 4802they must be equal to either `on' or `off', in which case the
4838operator or voice status of the user in the current channel is 4803operator or voice status of the user in the current channel is
@@ -4850,7 +4815,7 @@ If, and only if, changes are made, or the user is added,
4850See also: `erc-update-user' and `erc-update-channel-member'." 4815See also: `erc-update-user' and `erc-update-channel-member'."
4851 (let* (changed user-changed 4816 (let* (changed user-changed
4852 (channel-data (erc-get-channel-user nick)) 4817 (channel-data (erc-get-channel-user nick))
4853 (cuser (if channel-data (cdr channel-data))) 4818 (cuser (cdr channel-data))
4854 (user (if channel-data (car channel-data) 4819 (user (if channel-data (car channel-data)
4855 (erc-get-server-user nick)))) 4820 (erc-get-server-user nick))))
4856 (if cuser 4821 (if cuser
@@ -4908,7 +4873,7 @@ See also: `erc-update-user' and `erc-update-channel-member'."
4908(defun erc-update-channel-member (channel nick new-nick 4873(defun erc-update-channel-member (channel nick new-nick
4909 &optional add op voice host login 4874 &optional add op voice host login
4910 full-name info update-message-time) 4875 full-name info update-message-time)
4911 "Updates user and channel information for the user with 4876 "Update user and channel information for the user with
4912nickname NICK in channel CHANNEL. 4877nickname NICK in channel CHANNEL.
4913 4878
4914See also: `erc-update-current-channel-member'." 4879See also: `erc-update-current-channel-member'."
@@ -4951,7 +4916,6 @@ TOPIC string to the current topic."
4951 "Set the modes for the TGT provided as MODE-STRING." 4916 "Set the modes for the TGT provided as MODE-STRING."
4952 (let* ((modes (erc-parse-modes mode-string)) 4917 (let* ((modes (erc-parse-modes mode-string))
4953 (add-modes (nth 0 modes)) 4918 (add-modes (nth 0 modes))
4954 (remove-modes (nth 1 modes))
4955 ;; list of triples: (mode-char 'on/'off argument) 4919 ;; list of triples: (mode-char 'on/'off argument)
4956 (arg-modes (nth 2 modes))) 4920 (arg-modes (nth 2 modes)))
4957 (cond ((erc-channel-p tgt); channel modes 4921 (cond ((erc-channel-p tgt); channel modes
@@ -5040,6 +5004,7 @@ arg-modes is a list of triples of the form:
5040 "Update the mode information for TGT, provided as MODE-STRING. 5004 "Update the mode information for TGT, provided as MODE-STRING.
5041Optional arguments: NICK, HOST and LOGIN - the attributes of the 5005Optional arguments: NICK, HOST and LOGIN - the attributes of the
5042person who changed the modes." 5006person who changed the modes."
5007 ;; FIXME: neither of nick, host, and login are used!
5043 (let* ((modes (erc-parse-modes mode-string)) 5008 (let* ((modes (erc-parse-modes mode-string))
5044 (add-modes (nth 0 modes)) 5009 (add-modes (nth 0 modes))
5045 (remove-modes (nth 1 modes)) 5010 (remove-modes (nth 1 modes))
@@ -5197,8 +5162,7 @@ START and END describe positions in OBJECT.
5197If VALUE-LIST is nil, set each property in PROPERTIES to t, else set 5162If VALUE-LIST is nil, set each property in PROPERTIES to t, else set
5198each property to the corresponding value in VALUE-LIST." 5163each property to the corresponding value in VALUE-LIST."
5199 (unless value-list 5164 (unless value-list
5200 (setq value-list (mapcar (lambda (x) 5165 (setq value-list (mapcar (lambda (_x) t)
5201 t)
5202 properties))) 5166 properties)))
5203 (while (and properties value-list) 5167 (while (and properties value-list)
5204 (erc-put-text-property 5168 (erc-put-text-property
@@ -5290,7 +5254,7 @@ submitted line to be intentional."
5290 "Regular expression used for matching commands in ERC.") 5254 "Regular expression used for matching commands in ERC.")
5291 5255
5292(defun erc-send-input (input) 5256(defun erc-send-input (input)
5293 "Treat INPUT as typed in by the user. It is assumed that the input 5257 "Treat INPUT as typed in by the user. It is assumed that the input
5294and the prompt is already deleted. 5258and the prompt is already deleted.
5295This returns non-nil only if we actually send anything." 5259This returns non-nil only if we actually send anything."
5296 ;; Handle different kinds of inputs 5260 ;; Handle different kinds of inputs
@@ -5380,8 +5344,8 @@ list of the form: (command args) where both elements are strings."
5380 (when (string-match erc-command-regexp line) 5344 (when (string-match erc-command-regexp line)
5381 (let* ((cmd (erc-command-symbol (match-string 1 line))) 5345 (let* ((cmd (erc-command-symbol (match-string 1 line)))
5382 ;; note: return is nil, we apply this simply for side effects 5346 ;; note: return is nil, we apply this simply for side effects
5383 (canon-defun (while (and cmd (symbolp (symbol-function cmd))) 5347 (_canon-defun (while (and cmd (symbolp (symbol-function cmd)))
5384 (setq cmd (symbol-function cmd)))) 5348 (setq cmd (symbol-function cmd))))
5385 (cmd-fun (or cmd #'erc-cmd-default)) 5349 (cmd-fun (or cmd #'erc-cmd-default))
5386 (arg (if cmd 5350 (arg (if cmd
5387 (if (get cmd-fun 'do-not-parse-args) 5351 (if (get cmd-fun 'do-not-parse-args)
@@ -5449,22 +5413,18 @@ See also `erc-downcase'."
5449 5413
5450(defun erc-add-default-channel (channel) 5414(defun erc-add-default-channel (channel)
5451 "Add CHANNEL to the default channel list." 5415 "Add CHANNEL to the default channel list."
5452 5416 (let ((chl (downcase channel)))
5453 (let ((d1 (car erc-default-recipients))
5454 (d2 (cdr erc-default-recipients))
5455 (chl (downcase channel)))
5456 (setq erc-default-recipients 5417 (setq erc-default-recipients
5457 (cons chl erc-default-recipients)))) 5418 (cons chl erc-default-recipients))))
5458 5419
5459(defun erc-delete-default-channel (channel &optional buffer) 5420(defun erc-delete-default-channel (channel &optional buffer)
5460 "Delete CHANNEL from the default channel list." 5421 "Delete CHANNEL from the default channel list."
5461 (let ((ob (current-buffer))) 5422 (with-current-buffer (if (and buffer
5462 (with-current-buffer (if (and buffer 5423 (bufferp buffer))
5463 (bufferp buffer)) 5424 buffer
5464 buffer 5425 (current-buffer))
5465 (current-buffer)) 5426 (setq erc-default-recipients (delete (downcase channel)
5466 (setq erc-default-recipients (delete (downcase channel) 5427 erc-default-recipients))))
5467 erc-default-recipients)))))
5468 5428
5469(defun erc-add-query (nickname) 5429(defun erc-add-query (nickname)
5470 "Add QUERY'd NICKNAME to the default channel list. 5430 "Add QUERY'd NICKNAME to the default channel list.
@@ -5473,10 +5433,10 @@ The previous default target of QUERY type gets removed."
5473 (let ((d1 (car erc-default-recipients)) 5433 (let ((d1 (car erc-default-recipients))
5474 (d2 (cdr erc-default-recipients)) 5434 (d2 (cdr erc-default-recipients))
5475 (qt (cons 'QUERY (downcase nickname)))) 5435 (qt (cons 'QUERY (downcase nickname))))
5476 (if (and (listp d1) 5436 (setq erc-default-recipients (cons qt (if (and (listp d1)
5477 (eq (car d1) 'QUERY)) 5437 (eq (car d1) 'QUERY))
5478 (setq erc-default-recipients (cons qt d2)) 5438 d2
5479 (setq erc-default-recipients (cons qt erc-default-recipients))))) 5439 erc-default-recipients)))))
5480 5440
5481(defun erc-delete-query () 5441(defun erc-delete-query ()
5482 "Delete the topmost target if it is a QUERY." 5442 "Delete the topmost target if it is a QUERY."
@@ -5527,17 +5487,11 @@ The addressed target is the string before the first colon in MSG."
5527 (let ((nick (erc-server-user-nickname user)) 5487 (let ((nick (erc-server-user-nickname user))
5528 (host (erc-server-user-host user)) 5488 (host (erc-server-user-host user))
5529 (login (erc-server-user-login user))) 5489 (login (erc-server-user-login user)))
5530 (concat (if nick 5490 (concat (or nick "")
5531 nick
5532 "")
5533 "!" 5491 "!"
5534 (if login 5492 (or login "")
5535 login
5536 "")
5537 "@" 5493 "@"
5538 (if host 5494 (or host ""))))
5539 host
5540 ""))))
5541 5495
5542(defun erc-list-match (lst str) 5496(defun erc-list-match (lst str)
5543 "Return non-nil if any regexp in LST matches STR." 5497 "Return non-nil if any regexp in LST matches STR."
@@ -5588,7 +5542,7 @@ This command is sent even if excess flood is detected."
5588 (interactive "P") 5542 (interactive "P")
5589 (erc-set-active-buffer (current-buffer)) 5543 (erc-set-active-buffer (current-buffer))
5590 (let ((tgt (erc-default-target)) 5544 (let ((tgt (erc-default-target))
5591 (erc-force-send t)) 5545 (erc-force-send t)) ;FIXME: Not used anywhere!
5592 (cond ((or (not tgt) (not (erc-channel-p tgt))) 5546 (cond ((or (not tgt) (not (erc-channel-p tgt)))
5593 (erc-display-message nil 'error (current-buffer) 'no-target)) 5547 (erc-display-message nil 'error (current-buffer) 'no-target))
5594 (arg (erc-load-irc-script-lines (list (concat "/mode " tgt " -i")) 5548 (arg (erc-load-irc-script-lines (list (concat "/mode " tgt " -i"))
@@ -5626,7 +5580,7 @@ If CHANNEL is non-nil, toggle MODE for that channel, otherwise use
5626 (interactive "P") 5580 (interactive "P")
5627 (erc-set-active-buffer (current-buffer)) 5581 (erc-set-active-buffer (current-buffer))
5628 (let ((tgt (or channel (erc-default-target))) 5582 (let ((tgt (or channel (erc-default-target)))
5629 (erc-force-send t)) 5583 (erc-force-send t)) ;FIXME: Not used anywhere!
5630 (cond ((or (null tgt) (null (erc-channel-p tgt))) 5584 (cond ((or (null tgt) (null (erc-channel-p tgt)))
5631 (erc-display-message nil 'error 'active 'no-target)) 5585 (erc-display-message nil 'error 'active 'no-target))
5632 ((member mode erc-channel-modes) 5586 ((member mode erc-channel-modes)
@@ -5670,12 +5624,11 @@ specified in the list PATH.
5670If FILE is found, return the path to it." 5624If FILE is found, return the path to it."
5671 (let ((filepath file)) 5625 (let ((filepath file))
5672 (if (file-readable-p filepath) filepath 5626 (if (file-readable-p filepath) filepath
5673 (progn 5627 (while (and path
5674 (while (and path 5628 (progn (setq filepath (expand-file-name file (car path)))
5675 (progn (setq filepath (expand-file-name file (car path))) 5629 (not (file-readable-p filepath))))
5676 (not (file-readable-p filepath)))) 5630 (setq path (cdr path)))
5677 (setq path (cdr path))) 5631 (if path filepath nil))))
5678 (if path filepath nil)))))
5679 5632
5680(defun erc-select-startup-file () 5633(defun erc-select-startup-file ()
5681 "Select an ERC startup file. 5634 "Select an ERC startup file.
@@ -5789,7 +5742,6 @@ If optional NOEXPAND is non-nil, do not expand script-specific
5789sequences, process the lines verbatim. Use this for multiline 5742sequences, process the lines verbatim. Use this for multiline
5790user input." 5743user input."
5791 (let* ((cb (current-buffer)) 5744 (let* ((cb (current-buffer))
5792 (pnt (point))
5793 (s "") 5745 (s "")
5794 (sp (or (erc-command-indicator) (erc-prompt))) 5746 (sp (or (erc-command-indicator) (erc-prompt)))
5795 (args (and (boundp 'erc-script-args) erc-script-args))) 5747 (args (and (boundp 'erc-script-args) erc-script-args)))
@@ -6030,13 +5982,12 @@ entry of `channel-members'."
6030 (user (if channel-data 5982 (user (if channel-data
6031 (car channel-data) 5983 (car channel-data)
6032 (erc-get-server-user word))) 5984 (erc-get-server-user word)))
6033 host login full-name info nick op voice) 5985 host login full-name nick op voice)
6034 (when user 5986 (when user
6035 (setq nick (erc-server-user-nickname user) 5987 (setq nick (erc-server-user-nickname user)
6036 host (erc-server-user-host user) 5988 host (erc-server-user-host user)
6037 login (erc-server-user-login user) 5989 login (erc-server-user-login user)
6038 full-name (erc-server-user-full-name user) 5990 full-name (erc-server-user-full-name user))
6039 info (erc-server-user-info user))
6040 (if cuser 5991 (if cuser
6041 (setq op (erc-channel-user-op cuser) 5992 (setq op (erc-channel-user-op cuser)
6042 voice (erc-channel-user-voice cuser))) 5993 voice (erc-channel-user-voice cuser)))
@@ -6048,7 +5999,7 @@ entry of `channel-members'."
6048 (format " and is +%s%s on %s" 5999 (format " and is +%s%s on %s"
6049 (if op "o" "") 6000 (if op "o" "")
6050 (if voice "v" "") 6001 (if voice "v" "")
6051 (erc-default-target)) 6002 (erc-default-target))
6052 "")) 6003 ""))
6053 user)))) 6004 user))))
6054 6005
@@ -6597,7 +6548,7 @@ See also `format-spec'."
6597(add-hook 'kill-buffer-hook 'erc-kill-buffer-function) 6548(add-hook 'kill-buffer-hook 'erc-kill-buffer-function)
6598 6549
6599(defcustom erc-kill-server-hook '(erc-kill-server) 6550(defcustom erc-kill-server-hook '(erc-kill-server)
6600 "Invoked whenever a server-buffer is killed via `kill-buffer'." 6551 "Invoked whenever a server buffer is killed via `kill-buffer'."
6601 :group 'erc-hooks 6552 :group 'erc-hooks
6602 :type 'hook) 6553 :type 'hook)
6603 6554
@@ -6702,9 +6653,9 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL."
6702 6653
6703(provide 'erc) 6654(provide 'erc)
6704 6655
6705;;; Deprecated. We might eventually stop requiring the goodies automatically. 6656;; Deprecated. We might eventually stop requiring the goodies automatically.
6706;;; IMPORTANT: This require must appear _after_ the above (provide 'erc) to 6657;; IMPORTANT: This require must appear _after_ the above (provide 'erc) to
6707;;; avoid a recursive require error when byte-compiling the entire package. 6658;; avoid a recursive require error when byte-compiling the entire package.
6708(require 'erc-goodies) 6659(require 'erc-goodies)
6709 6660
6710;;; erc.el ends here 6661;;; erc.el ends here
diff --git a/lisp/files.el b/lisp/files.el
index efd89605b1b..f9ff3c936bd 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1603,13 +1603,16 @@ killed."
1603 "Create a suitably named buffer for visiting FILENAME, and return it. 1603 "Create a suitably named buffer for visiting FILENAME, and return it.
1604FILENAME (sans directory) is used unchanged if that name is free; 1604FILENAME (sans directory) is used unchanged if that name is free;
1605otherwise a string <2> or <3> or ... is appended to get an unused name. 1605otherwise a string <2> or <3> or ... is appended to get an unused name.
1606Spaces at the start of FILENAME (sans directory) are removed." 1606
1607Emacs treats buffers whose names begin with a space as internal buffers.
1608To avoid confusion when visiting a file whose name begins with a space,
1609this function prepends a \"|\" to the final result if necessary."
1607 (let ((lastname (file-name-nondirectory filename))) 1610 (let ((lastname (file-name-nondirectory filename)))
1608 (if (string= lastname "") 1611 (if (string= lastname "")
1609 (setq lastname filename)) 1612 (setq lastname filename))
1610 (save-match-data 1613 (generate-new-buffer (if (string-match-p "\\` " lastname)
1611 (string-match "^ *\\(.*\\)" lastname) 1614 (concat "|" lastname)
1612 (generate-new-buffer (match-string 1 lastname))))) 1615 lastname))))
1613 1616
1614(defun generate-new-buffer (name) 1617(defun generate-new-buffer (name)
1615 "Create and return a buffer with a name based on NAME. 1618 "Create and return a buffer with a name based on NAME.
@@ -2272,8 +2275,8 @@ since only a single case-insensitive search through the alist is made."
2272 ("\\.scm\\.[0-9]*\\'" . scheme-mode) 2275 ("\\.scm\\.[0-9]*\\'" . scheme-mode)
2273 ("\\.[ck]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode) 2276 ("\\.[ck]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode)
2274 ("\\.bash\\'" . sh-mode) 2277 ("\\.bash\\'" . sh-mode)
2275 ("\\(/\\|\\`\\)\\.\\(bash_profile\\|z?login\\|bash_login\\|z?logout\\)\\'" . sh-mode) 2278 ("\\(/\\|\\`\\)\\.\\(bash_\\(profile\\|history\\|log\\(in\\|out\\)\\)\\|z?log\\(in\\|out\\)\\)\\'" . sh-mode)
2276 ("\\(/\\|\\`\\)\\.\\(bash_logout\\|shrc\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode) 2279 ("\\(/\\|\\`\\)\\.\\(shrc\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode)
2277 ("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode) 2280 ("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode)
2278 ("\\.m?spec\\'" . sh-mode) 2281 ("\\.m?spec\\'" . sh-mode)
2279 ("\\.m[mes]\\'" . nroff-mode) 2282 ("\\.m[mes]\\'" . nroff-mode)
@@ -2451,6 +2454,7 @@ and `magic-mode-alist', which determines modes based on file contents.")
2451 ("wishx" . tcl-mode) 2454 ("wishx" . tcl-mode)
2452 ("tcl" . tcl-mode) 2455 ("tcl" . tcl-mode)
2453 ("tclsh" . tcl-mode) 2456 ("tclsh" . tcl-mode)
2457 ("expect" . tcl-mode)
2454 ("scm" . scheme-mode) 2458 ("scm" . scheme-mode)
2455 ("ash" . sh-mode) 2459 ("ash" . sh-mode)
2456 ("bash" . sh-mode) 2460 ("bash" . sh-mode)
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index e07d28a54d0..72cb6f7e894 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2246,7 +2246,8 @@ same as `substitute-in-file-name'."
2246 ;; - Cygwin (substitute-in-file-name "C:\bin") => "/usr/bin" 2246 ;; - Cygwin (substitute-in-file-name "C:\bin") => "/usr/bin"
2247 ;; (substitute-in-file-name "C:\") => "/" 2247 ;; (substitute-in-file-name "C:\") => "/"
2248 ;; (substitute-in-file-name "C:\bi") => "/bi" 2248 ;; (substitute-in-file-name "C:\bi") => "/bi"
2249 (let* ((ustr (substitute-in-file-name qstr)) 2249 (let* ((non-essential t)
2250 (ustr (substitute-in-file-name qstr))
2250 (uprefix (substring ustr 0 upos)) 2251 (uprefix (substring ustr 0 upos))
2251 qprefix) 2252 qprefix)
2252 ;; Main assumption: nothing after qpos should affect the text before upos, 2253 ;; Main assumption: nothing after qpos should affect the text before upos,
diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el
index 4b3fc91b0ff..b5216b43ed9 100644
--- a/lisp/progmodes/cc-awk.el
+++ b/lisp/progmodes/cc-awk.el
@@ -169,9 +169,9 @@
169 (concat "\\=_?\"" c-awk-string-innards-re)) 169 (concat "\\=_?\"" c-awk-string-innards-re))
170;; Matches an AWK string at point up to, but not including, any terminator. 170;; Matches an AWK string at point up to, but not including, any terminator.
171;; A gawk 3.1+ string may look like _"localizable string". 171;; A gawk 3.1+ string may look like _"localizable string".
172(defconst c-awk-one-line-possibly-open-string-re 172(defconst c-awk-possibly-open-string-re
173 (concat "\"\\(" c-awk-string-ch-re "\\|" c-awk-non-eol-esc-pair-re "\\)*" 173 (concat "\"\\(" c-awk-string-ch-re "\\|" c-awk-esc-pair-re "\\)*"
174 "\\(\"\\|\\\\?$\\|\\'\\)")) 174 "\\(\"\\|$\\|\\'\\)"))
175 175
176;; REGEXPS FOR AWK REGEXPS. 176;; REGEXPS FOR AWK REGEXPS.
177(defconst c-awk-regexp-normal-re "[^[/\\\n\r]") 177(defconst c-awk-regexp-normal-re "[^[/\\\n\r]")
@@ -192,25 +192,13 @@
192 "\\|" "[^]\n\r]" "\\)*" "\\(]\\|$\\)")) 192 "\\|" "[^]\n\r]" "\\)*" "\\(]\\|$\\)"))
193;; Matches a regexp char list, up to (but not including) EOL if the ] is 193;; Matches a regexp char list, up to (but not including) EOL if the ] is
194;; missing. 194;; missing.
195(defconst c-awk-regexp-one-line-possibly-open-char-list-re
196 (concat "\\[\\]?\\(" c-awk-non-eol-esc-pair-re "\\|" "[^]\n\r]" "\\)*"
197 "\\(]\\|\\\\?$\\|\\'\\)"))
198;; Matches the head (or all) of a regexp char class, up to (but not
199;; including) the first EOL.
200(defconst c-awk-regexp-innards-re 195(defconst c-awk-regexp-innards-re
201 (concat "\\(" c-awk-esc-pair-re "\\|" c-awk-regexp-char-list-re 196 (concat "\\(" c-awk-esc-pair-re "\\|" c-awk-regexp-char-list-re
202 "\\|" c-awk-regexp-normal-re "\\)*")) 197 "\\|" c-awk-regexp-normal-re "\\)*"))
203;; Matches the inside of an AWK regexp (i.e. without the enclosing /s) 198;; Matches the inside of an AWK regexp (i.e. without the enclosing /s)
204(defconst c-awk-regexp-without-end-re 199(defconst c-awk-regexp-without-end-re
205 (concat "/" c-awk-regexp-innards-re)) 200 (concat "/" c-awk-regexp-innards-re))
206;; Matches an AWK regexp up to, but not including, any terminating /. 201;; Matches an AWK regexp up to, but not including, any terminating /.
207(defconst c-awk-one-line-possibly-open-regexp-re
208 (concat "/\\(" c-awk-non-eol-esc-pair-re
209 "\\|" c-awk-regexp-one-line-possibly-open-char-list-re
210 "\\|" c-awk-regexp-normal-re "\\)*"
211 "\\(/\\|\\\\?$\\|\\'\\)"))
212;; Matches as much of the head of an AWK regexp which fits on one line,
213;; possibly all of it.
214 202
215;; REGEXPS used for scanning an AWK buffer in order to decide IF A '/' IS A 203;; REGEXPS used for scanning an AWK buffer in order to decide IF A '/' IS A
216;; REGEXP OPENER OR A DIVISION SIGN. By "state" in the following is meant 204;; REGEXP OPENER OR A DIVISION SIGN. By "state" in the following is meant
@@ -262,15 +250,24 @@
262 250
263;; REGEXPS USED FOR FINDING THE POSITION OF A "virtual semicolon" 251;; REGEXPS USED FOR FINDING THE POSITION OF A "virtual semicolon"
264(defconst c-awk-_-harmless-nonws-char-re "[^#/\"\\\\\n\r \t]") 252(defconst c-awk-_-harmless-nonws-char-re "[^#/\"\\\\\n\r \t]")
265;; NEW VERSION! (which will be restricted to the current line) 253(defconst c-awk-non-/-syn-ws*-re
266(defconst c-awk-one-line-non-syn-ws*-re 254 (concat
267 (concat "\\([ \t]*" 255 "\\(" c-awk-escaped-nls*-with-space*
268 "\\(" c-awk-_-harmless-nonws-char-re "\\|" 256 "\\(" c-awk-_-harmless-nonws-char-re "\\|"
269 c-awk-non-eol-esc-pair-re "\\|" 257 c-awk-non-eol-esc-pair-re "\\|"
270 c-awk-one-line-possibly-open-string-re "\\|" 258 c-awk-possibly-open-string-re
271 c-awk-one-line-possibly-open-regexp-re 259 "\\)"
272 "\\)" 260 "\\)*"))
273 "\\)*")) 261(defconst c-awk-space*-/-re (concat c-awk-escaped-nls*-with-space* "/"))
262;; Matches optional whitespace followed by "/".
263(defconst c-awk-space*-regexp-/-re
264 (concat c-awk-escaped-nls*-with-space* "\\s\""))
265;; Matches optional whitespace followed by a "/" with string syntax (a matched
266;; regexp delimiter).
267(defconst c-awk-space*-unclosed-regexp-/-re
268 (concat c-awk-escaped-nls*-with-space* "\\s\|"))
269;; Matches optional whitespace followed by a "/" with string fence syntax (an
270;; unmatched regexp delimiter).
274 271
275 272
276;; ACM, 2002/5/29: 273;; ACM, 2002/5/29:
@@ -549,10 +546,36 @@
549(defun c-awk-at-vsemi-p (&optional pos) 546(defun c-awk-at-vsemi-p (&optional pos)
550 ;; Is there a virtual semicolon at POS (or POINT)? 547 ;; Is there a virtual semicolon at POS (or POINT)?
551 (save-excursion 548 (save-excursion
552 (let (nl-prop 549 (let* (nl-prop
553 (pos-or-point (progn (if pos (goto-char pos)) (point)))) 550 (pos-or-point (progn (if pos (goto-char pos)) (point)))
554 (forward-line 0) 551 (bol (c-point 'bol)) (eol (c-point 'eol)))
555 (search-forward-regexp c-awk-one-line-non-syn-ws*-re) 552 (c-awk-beginning-of-logical-line)
553 ;; Next `while' goes round one logical line (ending in, e.g. "\\") per
554 ;; iteration. Such a line is rare, and can only be an open string
555 ;; ending in an escaped \.
556 (while
557 (progn
558 ;; Next `while' goes over a division sign or /regexp/ per iteration.
559 (while
560 (and
561 (< (point) eol)
562 (progn
563 (search-forward-regexp c-awk-non-/-syn-ws*-re eol)
564 (looking-at c-awk-space*-/-re)))
565 (cond
566 ((looking-at c-awk-space*-regexp-/-re) ; /regexp/
567 (forward-sexp))
568 ((looking-at c-awk-space*-unclosed-regexp-/-re) ; Unclosed /regexp
569 (condition-case nil
570 (progn
571 (forward-sexp)
572 (backward-char)) ; Move to end of (logical) line.
573 (error (end-of-line)))) ; Happens at EOB.
574 (t ; division sign
575 (c-forward-syntactic-ws)
576 (forward-char))))
577 (< (point) bol))
578 (forward-line))
556 (and (eq (point) pos-or-point) 579 (and (eq (point) pos-or-point)
557 (progn 580 (progn
558 (while (and (eq (setq nl-prop (c-awk-get-NL-prop-cur-line)) ?\\) 581 (while (and (eq (setq nl-prop (c-awk-get-NL-prop-cur-line)) ?\\)
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index c2ff5011a0e..3d6398014db 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -1271,6 +1271,9 @@ comment at the start of cc-engine.el for more info."
1271 (throw 'done (point))))) 1271 (throw 'done (point)))))
1272 ;; In trailing space after an as yet undetected virtual semicolon? 1272 ;; In trailing space after an as yet undetected virtual semicolon?
1273 (c-backward-syntactic-ws from) 1273 (c-backward-syntactic-ws from)
1274 (when (and (bolp) (not (bobp))) ; Can happen in AWK Mode with an
1275 ; unterminated string/regexp.
1276 (backward-char))
1274 (if (and (< (point) to) 1277 (if (and (< (point) to)
1275 (c-at-vsemi-p)) 1278 (c-at-vsemi-p))
1276 (point) 1279 (point)
@@ -9796,12 +9799,12 @@ comment at the start of cc-engine.el for more info."
9796 (not (eq (char-after) ?:)) 9799 (not (eq (char-after) ?:))
9797 ))) 9800 )))
9798 (save-excursion 9801 (save-excursion
9799 (c-backward-syntactic-ws lim) 9802 (c-beginning-of-statement-1 lim)
9800 (if (eq char-before-ip ?:) 9803 (when (looking-at c-opt-<>-sexp-key)
9801 (progn 9804 (goto-char (match-end 1))
9802 (forward-char -1) 9805 (c-forward-syntactic-ws)
9803 (c-backward-syntactic-ws lim))) 9806 (c-forward-<>-arglist nil)
9804 (back-to-indentation) 9807 (c-forward-syntactic-ws))
9805 (looking-at c-class-key))) 9808 (looking-at c-class-key)))
9806 ;; for Java 9809 ;; for Java
9807 (and (c-major-mode-is 'java-mode) 9810 (and (c-major-mode-is 'java-mode)
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 2c0a1317b04..0116e9ec3dd 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -2163,8 +2163,7 @@ assumed to be set if this isn't nil."
2163(c-lang-defconst c-opt-<>-sexp-key 2163(c-lang-defconst c-opt-<>-sexp-key
2164 ;; Adorned regexp matching keywords that can be followed by an angle 2164 ;; Adorned regexp matching keywords that can be followed by an angle
2165 ;; bracket sexp. Always set when `c-recognize-<>-arglists' is. 2165 ;; bracket sexp. Always set when `c-recognize-<>-arglists' is.
2166 t (if (c-lang-const c-recognize-<>-arglists) 2166 t (c-make-keywords-re t (c-lang-const c-<>-sexp-kwds)))
2167 (c-make-keywords-re t (c-lang-const c-<>-sexp-kwds))))
2168(c-lang-defvar c-opt-<>-sexp-key (c-lang-const c-opt-<>-sexp-key)) 2167(c-lang-defvar c-opt-<>-sexp-key (c-lang-const c-opt-<>-sexp-key))
2169 2168
2170(c-lang-defconst c-brace-id-list-kwds 2169(c-lang-defconst c-brace-id-list-kwds
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 29020d95226..c8b65e0a029 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -497,6 +497,9 @@ This is buffer-local in every such buffer.")
497 (define-key map "\C-c+" 'sh-add) 497 (define-key map "\C-c+" 'sh-add)
498 (define-key map "\C-\M-x" 'sh-execute-region) 498 (define-key map "\C-\M-x" 'sh-execute-region)
499 (define-key map "\C-c\C-x" 'executable-interpret) 499 (define-key map "\C-c\C-x" 'executable-interpret)
500 (define-key map "\C-c\C-n" 'sh-send-line-or-region-and-step)
501 (define-key map "\C-c\C-d" 'sh-cd-here)
502 (define-key map "\C-c\C-z" 'sh-show-shell)
500 503
501 (define-key map [remap delete-backward-char] 504 (define-key map [remap delete-backward-char]
502 'backward-delete-char-untabify) 505 'backward-delete-char-untabify)
@@ -1462,6 +1465,61 @@ The default is t because I assume that in one Emacs session one is
1462frequently editing existing scripts with different styles.") 1465frequently editing existing scripts with different styles.")
1463 1466
1464 1467
1468;; inferior shell interaction
1469;; TODO: support multiple interactive shells
1470(defvar sh-shell-process nil
1471 "The inferior shell process for interaction.")
1472(make-variable-buffer-local 'sh-shell-process)
1473(defun sh-shell-process (force)
1474 "Get a shell process for interaction.
1475If FORCE is non-nil and no process found, create one."
1476 (if (and sh-shell-process (process-live-p sh-shell-process))
1477 sh-shell-process
1478 (setq sh-shell-process
1479 (let ((found nil) proc
1480 (procs (process-list)))
1481 (while (and (not found) procs
1482 (process-live-p (setq proc (pop procs)))
1483 (process-command proc))
1484 (when (string-equal sh-shell (file-name-nondirectory
1485 (car (process-command proc))))
1486 (setq found proc)))
1487 (or found
1488 (and force
1489 (get-buffer-process
1490 (let ((explicit-shell-file-name sh-shell-file))
1491 (shell)))))))))
1492
1493(defun sh-show-shell ()
1494 "Pop the shell interaction buffer."
1495 (interactive)
1496 (pop-to-buffer (process-buffer (sh-shell-process t))))
1497
1498(defun sh-send-text (text)
1499 "Send the text to the `sh-shell-process'."
1500 (comint-send-string (sh-shell-process t) (concat text "\n")))
1501
1502(defun sh-cd-here ()
1503 "Change directory in the current interaction shell to the current one."
1504 (interactive)
1505 (sh-send-text (concat "cd " default-directory)))
1506
1507(defun sh-send-line-or-region-and-step ()
1508 "Send the current line to the inferior shell and step to the next line.
1509When the region is active, send the region instead."
1510 (interactive)
1511 (let (from to end)
1512 (if (use-region-p)
1513 (setq from (region-beginning)
1514 to (region-end)
1515 end to)
1516 (setq from (line-beginning-position)
1517 to (line-end-position)
1518 end (1+ to)))
1519 (sh-send-text (buffer-substring-no-properties from to))
1520 (goto-char end)))
1521
1522
1465;; mode-command and utility functions 1523;; mode-command and utility functions
1466 1524
1467;;;###autoload 1525;;;###autoload
@@ -2169,6 +2227,7 @@ Calls the value of `sh-set-shell-hook' if set."
2169 (setq font-lock-set-defaults nil) 2227 (setq font-lock-set-defaults nil)
2170 (font-lock-set-defaults) 2228 (font-lock-set-defaults)
2171 (font-lock-fontify-buffer)) 2229 (font-lock-fontify-buffer))
2230 (setq sh-shell-process nil)
2172 (run-hooks 'sh-set-shell-hook)) 2231 (run-hooks 'sh-set-shell-hook))
2173 2232
2174 2233
diff --git a/lisp/rfn-eshadow.el b/lisp/rfn-eshadow.el
index cf5f1d16974..8d29c43980c 100644
--- a/lisp/rfn-eshadow.el
+++ b/lisp/rfn-eshadow.el
@@ -176,11 +176,11 @@ This is intended to be used as a minibuffer `post-command-hook' for
176`file-name-shadow-mode'; the minibuffer should have already 176`file-name-shadow-mode'; the minibuffer should have already
177been set up by `rfn-eshadow-setup-minibuffer'." 177been set up by `rfn-eshadow-setup-minibuffer'."
178 (condition-case nil 178 (condition-case nil
179 (let ((goal (substitute-in-file-name (minibuffer-contents))) 179 (let* ((non-essential t)
180 (mid (overlay-end rfn-eshadow-overlay)) 180 (goal (substitute-in-file-name (minibuffer-contents)))
181 (start (minibuffer-prompt-end)) 181 (mid (overlay-end rfn-eshadow-overlay))
182 (end (point-max)) 182 (start (minibuffer-prompt-end))
183 (non-essential t)) 183 (end (point-max)))
184 (unless 184 (unless
185 ;; Catch the common case where the shadow does not need to move. 185 ;; Catch the common case where the shadow does not need to move.
186 (and mid 186 (and mid
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index 5b6d5f359e6..119b4b04593 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -220,7 +220,7 @@ Remove indentation from each line."
220 (let ((str (or 220 (let ((str (or
221 (and adaptive-fill-function (funcall adaptive-fill-function)) 221 (and adaptive-fill-function (funcall adaptive-fill-function))
222 (and adaptive-fill-regexp (looking-at adaptive-fill-regexp) 222 (and adaptive-fill-regexp (looking-at adaptive-fill-regexp)
223 (match-string-no-properties 0))))) 223 (match-string 0)))))
224 (if (>= (+ (current-left-margin) (length str)) (current-fill-column)) 224 (if (>= (+ (current-left-margin) (length str)) (current-fill-column))
225 ;; Death to insanely long prefixes. 225 ;; Death to insanely long prefixes.
226 nil 226 nil
diff --git a/lisp/window.el b/lisp/window.el
index 64cf0a72110..21e40071782 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -5642,7 +5642,10 @@ new frame."
5642 (fun pop-up-frame-function) 5642 (fun pop-up-frame-function)
5643 frame window) 5643 frame window)
5644 (when (and fun 5644 (when (and fun
5645 (setq frame (funcall fun)) 5645 ;; Make BUFFER current so `make-frame' will use it as the
5646 ;; new frame's buffer (Bug#15133).
5647 (with-current-buffer buffer
5648 (setq frame (funcall fun)))
5646 (setq window (frame-selected-window frame))) 5649 (setq window (frame-selected-window frame)))
5647 (prog1 (window--display-buffer 5650 (prog1 (window--display-buffer
5648 buffer window 'frame alist display-buffer-mark-dedicated) 5651 buffer window 'frame alist display-buffer-mark-dedicated)