Revert "* lisp/calc/calc-ext.el (math-scalarp): Fix typo"
This reverts commit 698ff554ac.
This commit is contained in:
Stefan Monnier
parent
699fce296b
commit
0b4e003766
59 changed files with 818 additions and 915 deletions
|
|
@ -1,6 +1,6 @@
|
|||
((nil . ((tab-width . 8)
|
||||
(sentence-end-double-space . t)
|
||||
(fill-column . 79)
|
||||
(fill-column . 70)
|
||||
(bug-reference-url-format . "https://debbugs.gnu.org/%s")))
|
||||
(c-mode . ((c-file-style . "GNU")
|
||||
(c-noise-macro-names . ("INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED" "UNINIT" "CALLBACK" "ALIGN_STACK"))
|
||||
|
|
|
|||
1
.gitignore
vendored
1
.gitignore
vendored
|
|
@ -251,6 +251,7 @@ gnustmp*
|
|||
|
||||
# Version control and locks.
|
||||
*.orig
|
||||
*.rej
|
||||
*.swp
|
||||
*~
|
||||
.#*
|
||||
|
|
|
|||
|
|
@ -63,8 +63,7 @@ EMACS = ../src/emacs${EXEEXT}
|
|||
EMACSOPT = -batch --no-site-file --no-site-lisp
|
||||
|
||||
# Extra flags to pass to the byte compiler
|
||||
BYTE_COMPILE_EXTRA_FLAGS = --eval '(setq byte-compile-force-lexical-warnings t)'
|
||||
|
||||
BYTE_COMPILE_EXTRA_FLAGS =
|
||||
# For example to not display the undefined function warnings you can use this:
|
||||
# BYTE_COMPILE_EXTRA_FLAGS = --eval '(setq byte-compile-warnings (quote (not unresolved)))'
|
||||
# The example above is just for developers, it should not be used by default.
|
||||
|
|
@ -86,7 +85,7 @@ AUTOGENEL = ${loaddefs} ${srcdir}/cus-load.el ${srcdir}/finder-inf.el \
|
|||
|
||||
# Set load-prefer-newer for the benefit of the non-bootstrappers.
|
||||
BYTE_COMPILE_FLAGS = \
|
||||
--eval '(setq load-prefer-newer t byte-compile-force-lexical-warnings t)' $(BYTE_COMPILE_EXTRA_FLAGS)
|
||||
--eval '(setq load-prefer-newer t)' $(BYTE_COMPILE_EXTRA_FLAGS)
|
||||
|
||||
# Files to compile before others during a bootstrap. This is done to
|
||||
# speed up the bootstrap process. They're ordered by size, so we use
|
||||
|
|
@ -317,7 +316,7 @@ compile-targets: $(TARGETS)
|
|||
# Compile all the Elisp files that need it. Beware: it approximates
|
||||
# 'no-byte-compile', so watch out for false-positives!
|
||||
compile-main: gen-lisp compile-clean
|
||||
@(cd $(lisp) && \
|
||||
@(cd $(lisp) && \
|
||||
els=`echo "${SUBDIRS_REL} " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.el |g'`; \
|
||||
for el in ${MAIN_FIRST} $$els; do \
|
||||
test -f $$el || continue; \
|
||||
|
|
|
|||
|
|
@ -648,8 +648,7 @@ either a single abbrev table or a list of abbrev tables."
|
|||
;; to treat the distinction between a single table and a list of tables.
|
||||
(cond
|
||||
((consp tables) tables)
|
||||
((abbrev-table-p tables) (list tables))
|
||||
(tables (signal 'wrong-type-argument (list 'abbrev-table-p tables)))
|
||||
((vectorp tables) (list tables))
|
||||
(t
|
||||
(let ((tables (if (listp local-abbrev-table)
|
||||
(append local-abbrev-table
|
||||
|
|
|
|||
|
|
@ -31,8 +31,9 @@
|
|||
(require 'calc-macs)
|
||||
|
||||
|
||||
;; Find out how many 9s in 9.9999... will give distinct Emacs floats,
|
||||
;; then back off by one.
|
||||
;;; Find out how many 9s in 9.9999... will give distinct Emacs floats,
|
||||
;;; then back off by one.
|
||||
|
||||
(defvar math-emacs-precision
|
||||
(let* ((n 1)
|
||||
(x 9)
|
||||
|
|
@ -45,9 +46,9 @@
|
|||
(1- n))
|
||||
"The number of digits in an Emacs float.")
|
||||
|
||||
;; Find the largest power of 10 which is an Emacs float,
|
||||
;; then back off by one so that any float d.dddd...eN
|
||||
;; is an Emacs float, for acceptable d.dddd....
|
||||
;;; Find the largest power of 10 which is an Emacs float,
|
||||
;;; then back off by one so that any float d.dddd...eN
|
||||
;;; is an Emacs float, for acceptable d.dddd....
|
||||
|
||||
(defvar math-largest-emacs-expt
|
||||
(let ((x 1)
|
||||
|
|
@ -366,9 +367,9 @@ If this can't be done, return NIL."
|
|||
(message "Angles measured in radians")))
|
||||
|
||||
|
||||
;; Compute the integer square-root floor(sqrt(A)). A > 0. [I I] [Public]
|
||||
;; This method takes advantage of the fact that Newton's method starting
|
||||
;; with an overestimate always works, even using truncating integer division!
|
||||
;;; Compute the integer square-root floor(sqrt(A)). A > 0. [I I] [Public]
|
||||
;;; This method takes advantage of the fact that Newton's method starting
|
||||
;;; with an overestimate always works, even using truncating integer division!
|
||||
(defun math-isqrt (a)
|
||||
(cond ((Math-zerop a) a)
|
||||
((not (natnump a))
|
||||
|
|
|
|||
|
|
@ -156,9 +156,9 @@ If DATE lacks timezone information, GMT is assumed."
|
|||
(let ((overflow-error '(error "Specified time is not representable")))
|
||||
(if (equal err overflow-error)
|
||||
(signal (car err) (cdr err))
|
||||
(condition-case-unless-debug err
|
||||
(condition-case err
|
||||
(encode-time (parse-time-string
|
||||
(timezone-make-date-arpa-standard date)))
|
||||
(timezone-make-date-arpa-standard date)))
|
||||
(error
|
||||
(if (equal err overflow-error)
|
||||
(signal (car err) (cdr err))
|
||||
|
|
|
|||
|
|
@ -2221,7 +2221,7 @@ TYPE is the type of the wrapper to be added. Can be :before or :under."
|
|||
(defun completion-before-command ()
|
||||
(funcall (or (and (symbolp this-command)
|
||||
(get this-command 'completion-function))
|
||||
#'use-completion-under-or-before-point)))
|
||||
'use-completion-under-or-before-point)))
|
||||
|
||||
;; Lisp mode diffs.
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; composite.el --- support character composition -*- lexical-binding:t -*-
|
||||
;;; composite.el --- support character composition
|
||||
|
||||
;; Copyright (C) 2001-2019 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -588,6 +588,7 @@ All non-spacing characters have this function in
|
|||
(as (lglyph-ascent glyph))
|
||||
(de (lglyph-descent glyph))
|
||||
(ce (/ (+ lb rb) 2))
|
||||
(w (lglyph-width glyph))
|
||||
xoff yoff)
|
||||
(cond
|
||||
((and class (>= class 200) (<= class 240))
|
||||
|
|
@ -688,7 +689,9 @@ All non-spacing characters have this function in
|
|||
|
||||
(defun compose-gstring-for-dotted-circle (gstring direction)
|
||||
(let* ((dc (lgstring-glyph gstring 0)) ; glyph of dotted-circle
|
||||
(dc-id (lglyph-code dc))
|
||||
(fc (lgstring-glyph gstring 1)) ; glyph of the following char
|
||||
(fc-id (lglyph-code fc))
|
||||
(gstr (and nil (font-shape-gstring gstring direction))))
|
||||
(if (and gstr
|
||||
(or (= (lgstring-glyph-len gstr) 1)
|
||||
|
|
|
|||
|
|
@ -551,8 +551,7 @@ happened."
|
|||
(goto-char pos)
|
||||
(funcall electric-pair-inhibit-predicate
|
||||
last-command-event)))))
|
||||
(let ((electric-indent--destination (point-marker)))
|
||||
(save-excursion (electric-pair--insert pair))))))
|
||||
(save-excursion (electric-pair--insert pair)))))
|
||||
(_
|
||||
(when (and (if (functionp electric-pair-open-newline-between-pairs)
|
||||
(funcall electric-pair-open-newline-between-pairs)
|
||||
|
|
|
|||
|
|
@ -220,14 +220,6 @@ If `indent-line-function' is one of those, then `electric-indent-mode' will
|
|||
not try to reindent lines. It is normally better to make the major
|
||||
mode set `electric-indent-inhibit', but this can be used as a workaround.")
|
||||
|
||||
(defun electric-indent--inhibited-p ()
|
||||
(or electric-indent-inhibit
|
||||
(memq indent-line-function
|
||||
electric-indent-functions-without-reindent)))
|
||||
|
||||
(defvar electric-indent--destination nil
|
||||
"If non-nil, position to which point will be later restored.")
|
||||
|
||||
(defun electric-indent-post-self-insert-function ()
|
||||
"Function that `electric-indent-mode' adds to `post-self-insert-hook'.
|
||||
This indents if the hook `electric-indent-functions' returns non-nil,
|
||||
|
|
@ -269,26 +261,26 @@ or comment."
|
|||
(when at-newline
|
||||
(let ((before (copy-marker (1- pos) t)))
|
||||
(save-excursion
|
||||
(unless (electric-indent--inhibited-p)
|
||||
(unless
|
||||
(or (memq indent-line-function
|
||||
electric-indent-functions-without-reindent)
|
||||
electric-indent-inhibit)
|
||||
;; Don't reindent the previous line if the
|
||||
;; indentation function is not a real one.
|
||||
(goto-char before)
|
||||
(condition-case-unless-debug ()
|
||||
(indent-according-to-mode)
|
||||
(error (throw 'indent-error nil))))
|
||||
;; The goal here will be to remove the trailing
|
||||
;; whitespace after reindentation of the previous line
|
||||
;; because that may have (re)introduced it.
|
||||
(goto-char before)
|
||||
;; We were at EOL in marker `before' before the call
|
||||
;; to `indent-according-to-mode' but after we may
|
||||
;; not be (Bug#15767).
|
||||
(when (and (eolp)
|
||||
;; Don't delete "trailing space" before point!
|
||||
(not (and electric-indent--destination
|
||||
(= (point) electric-indent--destination))))
|
||||
(delete-horizontal-space t)))))
|
||||
(unless (and (electric-indent--inhibited-p)
|
||||
(error (throw 'indent-error nil)))
|
||||
;; The goal here will be to remove the trailing
|
||||
;; whitespace after reindentation of the previous line
|
||||
;; because that may have (re)introduced it.
|
||||
(goto-char before)
|
||||
;; We were at EOL in marker `before' before the call
|
||||
;; to `indent-according-to-mode' but after we may
|
||||
;; not be (Bug#15767).
|
||||
(when (and (eolp))
|
||||
(delete-horizontal-space t))))))
|
||||
(unless (and electric-indent-inhibit
|
||||
(not at-newline))
|
||||
(condition-case-unless-debug ()
|
||||
(indent-according-to-mode)
|
||||
|
|
|
|||
|
|
@ -2981,7 +2981,7 @@ for symbols generated by the byte compiler itself."
|
|||
lexenv reserved-csts)
|
||||
;; OUTPUT-TYPE advises about how form is expected to be used:
|
||||
;; 'eval or nil -> a single form,
|
||||
;; t -> a list of forms,
|
||||
;; 'progn or t -> a list of forms,
|
||||
;; 'lambda -> body of a lambda,
|
||||
;; 'file -> used at file-level.
|
||||
(let ((byte-compile--for-effect for-effect)
|
||||
|
|
@ -3044,19 +3044,21 @@ for symbols generated by the byte compiler itself."
|
|||
;; a single atom, but that causes confusion if the docstring
|
||||
;; uses the (file . pos) syntax. Besides, now that we have
|
||||
;; the Lisp_Compiled type, the compiled form is faster.
|
||||
;; eval/nil-> atom, quote or (function atom atom atom)
|
||||
;; t -> as <<same-as-eval>> or (progn <<same-as-eval>> atom)
|
||||
;; eval -> atom, quote or (function atom atom atom)
|
||||
;; progn -> as <<same-as-eval>> or (progn <<same-as-eval>> atom)
|
||||
;; file -> as progn, but takes both quotes and atoms, and longer forms.
|
||||
(let (body tmp)
|
||||
(let (rest
|
||||
(maycall (not (eq output-type 'lambda))) ; t if we may make a funcall.
|
||||
tmp body)
|
||||
(cond
|
||||
;; #### This should be split out into byte-compile-nontrivial-function-p.
|
||||
((or (eq output-type 'lambda)
|
||||
(nthcdr (if (eq output-type 'file) 50 8) byte-compile-output)
|
||||
(assq 'TAG byte-compile-output) ; Not necessary, but speeds up a bit.
|
||||
(not (setq tmp (assq 'byte-return byte-compile-output)))
|
||||
(let ((maycall t) ; t if we may make a funcall.
|
||||
(rest (nreverse
|
||||
(cdr (memq tmp (reverse byte-compile-output))))))
|
||||
(progn
|
||||
(setq rest (nreverse
|
||||
(cdr (memq tmp (reverse byte-compile-output)))))
|
||||
(while
|
||||
(cond
|
||||
((memq (car (car rest)) '(byte-varref byte-constant))
|
||||
|
|
@ -3065,7 +3067,7 @@ for symbols generated by the byte compiler itself."
|
|||
(or (consp tmp)
|
||||
(and (symbolp tmp)
|
||||
(not (macroexp--const-symbol-p tmp)))))
|
||||
(if maycall ;;Why? --Stef
|
||||
(if maycall
|
||||
(setq body (cons (list 'quote tmp) body)))
|
||||
(setq body (cons tmp body))))
|
||||
((and maycall
|
||||
|
|
@ -3073,7 +3075,7 @@ for symbols generated by the byte compiler itself."
|
|||
(null (nthcdr 3 rest))
|
||||
(setq tmp (get (car (car rest)) 'byte-opcode-invert))
|
||||
(or (null (cdr rest))
|
||||
(and (memq output-type '(file t))
|
||||
(and (memq output-type '(file progn t))
|
||||
(cdr (cdr rest))
|
||||
(eq (car (nth 1 rest)) 'byte-discard)
|
||||
(progn (setq rest (cdr rest)) t))))
|
||||
|
|
|
|||
|
|
@ -234,13 +234,73 @@ Some generic modes are defined in `generic-x.el'."
|
|||
(cond
|
||||
((characterp end) (setq end (char-to-string end)))
|
||||
((zerop (length end)) (setq end "\n")))
|
||||
(push (list start end) normalized)))
|
||||
(push (cons start end) normalized)))
|
||||
(nreverse normalized)))
|
||||
|
||||
(defun generic-set-comment-syntax (st comment-list)
|
||||
"Set up comment functionality for generic mode."
|
||||
(let ((chars nil)
|
||||
(comstyles)
|
||||
(comstyle "")
|
||||
(comment-start nil))
|
||||
|
||||
;; Go through all the comments.
|
||||
(pcase-dolist (`(,start . ,end) comment-list)
|
||||
(let ((comstyle
|
||||
;; Reuse comstyles if necessary.
|
||||
(or (cdr (assoc start comstyles))
|
||||
(cdr (assoc end comstyles))
|
||||
;; Otherwise, use a style not yet in use.
|
||||
(if (not (rassoc "" comstyles)) "")
|
||||
(if (not (rassoc "b" comstyles)) "b")
|
||||
"c")))
|
||||
(push (cons start comstyle) comstyles)
|
||||
(push (cons end comstyle) comstyles)
|
||||
|
||||
;; Setup the syntax table.
|
||||
(if (= (length start) 1)
|
||||
(modify-syntax-entry (aref start 0)
|
||||
(concat "< " comstyle) st)
|
||||
(let ((c0 (aref start 0)) (c1 (aref start 1)))
|
||||
;; Store the relevant info but don't update yet.
|
||||
(push (cons c0 (concat (cdr (assoc c0 chars)) "1")) chars)
|
||||
(push (cons c1 (concat (cdr (assoc c1 chars))
|
||||
(concat "2" comstyle))) chars)))
|
||||
(if (= (length end) 1)
|
||||
(modify-syntax-entry (aref end 0)
|
||||
(concat ">" comstyle) st)
|
||||
(let ((c0 (aref end 0)) (c1 (aref end 1)))
|
||||
;; Store the relevant info but don't update yet.
|
||||
(push (cons c0 (concat (cdr (assoc c0 chars))
|
||||
(concat "3" comstyle))) chars)
|
||||
(push (cons c1 (concat (cdr (assoc c1 chars)) "4")) chars)))))
|
||||
|
||||
;; Process the chars that were part of a 2-char comment marker
|
||||
(with-syntax-table st ;For `char-syntax'.
|
||||
(dolist (cs (nreverse chars))
|
||||
(modify-syntax-entry (car cs)
|
||||
(concat (char-to-string (char-syntax (car cs)))
|
||||
" " (cdr cs))
|
||||
st)))))
|
||||
|
||||
(defun generic-set-comment-vars (comment-list)
|
||||
(when comment-list
|
||||
(setq-local comment-start (caar comment-list))
|
||||
(setq-local comment-end
|
||||
(let ((end (cdar comment-list)))
|
||||
(if (string-equal end "\n") "" end)))
|
||||
(setq-local comment-start-skip
|
||||
(concat (regexp-opt (mapcar #'car comment-list))
|
||||
"+[ \t]*"))
|
||||
(setq-local comment-end-skip
|
||||
(concat "[ \t]*" (regexp-opt (mapcar #'cdr comment-list))))))
|
||||
|
||||
(defun generic-mode-set-comments (comment-list)
|
||||
"Set up comment functionality for generic mode."
|
||||
(let ((st (make-syntax-table)))
|
||||
(comment-set-syntax st comment-list)
|
||||
(let ((st (make-syntax-table))
|
||||
(comment-list (generic--normalize-comments comment-list)))
|
||||
(generic-set-comment-syntax st comment-list)
|
||||
(generic-set-comment-vars comment-list)
|
||||
(set-syntax-table st)))
|
||||
|
||||
(defun generic-bracket-support ()
|
||||
|
|
|
|||
|
|
@ -237,7 +237,6 @@
|
|||
(eval-when-compile
|
||||
(concat "(\\(" lisp-mode-symbol-regexp "\\)\\_>"))
|
||||
limit t)
|
||||
;; FIXME: If it's indented like `defun' then highlight the first arg!
|
||||
(let ((sym (intern-soft (match-string 1))))
|
||||
(when (or (special-form-p sym)
|
||||
(and (macrop sym)
|
||||
|
|
|
|||
|
|
@ -1163,6 +1163,26 @@ The return result is a `package-desc'."
|
|||
(insert (format "Error while verifying signature %s:\n" sig-file)))
|
||||
(insert "\nCommand output:\n" (epg-context-error-output context))))))
|
||||
|
||||
(defmacro package--with-work-buffer (location file &rest body)
|
||||
"Run BODY in a buffer containing the contents of FILE at LOCATION.
|
||||
LOCATION is the base location of a package archive, and should be
|
||||
one of the URLs (or file names) specified in `package-archives'.
|
||||
FILE is the name of a file relative to that base location.
|
||||
|
||||
This macro retrieves FILE from LOCATION into a temporary buffer,
|
||||
and evaluates BODY while that buffer is current. This work
|
||||
buffer is killed afterwards. Return the last value in BODY."
|
||||
(declare (indent 2) (debug t)
|
||||
(obsolete package--with-response-buffer "25.1"))
|
||||
`(with-temp-buffer
|
||||
(if (string-match-p "\\`https?:" ,location)
|
||||
(url-insert-file-contents (concat ,location ,file))
|
||||
(unless (file-name-absolute-p ,location)
|
||||
(error "Archive location %s is not an absolute file name"
|
||||
,location))
|
||||
(insert-file-contents (expand-file-name ,file ,location)))
|
||||
,@body))
|
||||
|
||||
(cl-defmacro package--with-response-buffer (url &rest body &key async file error-form noerror &allow-other-keys)
|
||||
"Access URL and run BODY in a buffer containing the response.
|
||||
Point is after the headers when BODY runs.
|
||||
|
|
|
|||
|
|
@ -97,34 +97,11 @@
|
|||
(declare-function get-edebug-spec "edebug" (symbol))
|
||||
(declare-function edebug-match "edebug" (cursor specs))
|
||||
|
||||
(defun pcase--get-macroexpander (s)
|
||||
"Return the macroexpander for pcase pattern head S, or nil"
|
||||
(let ((em (assoc s (assq :pcase-macroexpander macroexpand-all-environment))))
|
||||
(if em (cdr em)
|
||||
(get s 'pcase-macroexpander))))
|
||||
|
||||
(defmacro pcase-macrolet (bindings &rest body)
|
||||
(let ((new-macros (if (consp (car-safe bindings))
|
||||
(mapcar (lambda (binding)
|
||||
(cons (car binding)
|
||||
(eval (if (cddr binding)
|
||||
`(lambda ,(cadr binding)
|
||||
,@(cddr binding))
|
||||
(cadr binding))
|
||||
lexical-binding)))
|
||||
bindings)
|
||||
(eval bindings lexical-binding)))
|
||||
(old-pme (assq :pcase-macroexpander macroexpand-all-environment)))
|
||||
(macroexpand-all (macroexp-progn body)
|
||||
(cons (cons :pcase-macroexpander
|
||||
(append new-macros old-pme))
|
||||
macroexpand-all-environment))))
|
||||
|
||||
(defun pcase--edebug-match-macro (cursor)
|
||||
(let (specs)
|
||||
(mapatoms
|
||||
(lambda (s)
|
||||
(let ((m (pcase--get-macroexpander s)))
|
||||
(let ((m (get s 'pcase-macroexpander)))
|
||||
(when (and m (get-edebug-spec m))
|
||||
(push (cons (symbol-name s) (get-edebug-spec m))
|
||||
specs)))))
|
||||
|
|
@ -216,7 +193,7 @@ Emacs Lisp manual for more information and examples."
|
|||
(let (more)
|
||||
;; Collect all the extensions.
|
||||
(mapatoms (lambda (symbol)
|
||||
(let ((me (pcase--get-macroexpander symbol)))
|
||||
(let ((me (get symbol 'pcase-macroexpander)))
|
||||
(when me
|
||||
(push (cons symbol me)
|
||||
more)))))
|
||||
|
|
@ -442,7 +419,7 @@ of the elements of LIST is performed as if by `pcase-let'.
|
|||
((eq head 'let) `(let ,(pcase--macroexpand (cadr pat)) ,@(cddr pat)))
|
||||
((eq head 'app) `(app ,(nth 1 pat) ,(pcase--macroexpand (nth 2 pat))))
|
||||
(t
|
||||
(let* ((expander (pcase--get-macroexpander head))
|
||||
(let* ((expander (get head 'pcase-macroexpander))
|
||||
(npat (if expander (apply expander (cdr pat)))))
|
||||
(if (null npat)
|
||||
(error (if expander
|
||||
|
|
|
|||
|
|
@ -141,7 +141,7 @@ usually more efficient than that of a simplified version:
|
|||
(completion-regexp-list nil)
|
||||
(open (cond ((stringp paren) paren) (paren "\\(")))
|
||||
(sorted-strings (delete-dups
|
||||
(sort (copy-sequence strings) #'string-lessp)))
|
||||
(sort (copy-sequence strings) 'string-lessp)))
|
||||
(re
|
||||
(cond
|
||||
;; No strings: return an unmatchable regexp.
|
||||
|
|
|
|||
|
|
@ -239,7 +239,7 @@ be either:
|
|||
;; (exp (exp (or "+" "*" "=" ..) exp)).
|
||||
;; Basically, make it EBNF (except for the specification of a separator in
|
||||
;; the repetition, maybe).
|
||||
(let* ((nts (mapcar #'car bnf)) ;Non-terminals.
|
||||
(let* ((nts (mapcar 'car bnf)) ;Non-terminals.
|
||||
(first-ops-table ())
|
||||
(last-ops-table ())
|
||||
(first-nts-table ())
|
||||
|
|
@ -258,7 +258,7 @@ be either:
|
|||
(push resolver precs))
|
||||
(t (error "Unknown resolver %S" resolver))))
|
||||
(apply #'smie-merge-prec2s over
|
||||
(mapcar #'smie-precs->prec2 precs))))
|
||||
(mapcar 'smie-precs->prec2 precs))))
|
||||
again)
|
||||
(dolist (rules bnf)
|
||||
(let ((nt (car rules))
|
||||
|
|
@ -489,7 +489,7 @@ CSTS is a list of pairs representing arcs in a graph."
|
|||
res))
|
||||
cycle)))
|
||||
(mapconcat
|
||||
(lambda (elems) (mapconcat #'identity elems "="))
|
||||
(lambda (elems) (mapconcat 'identity elems "="))
|
||||
(append names (list (car names)))
|
||||
" < ")))
|
||||
|
||||
|
|
@ -559,7 +559,7 @@ PREC2 is a table as returned by `smie-precs->prec2' or
|
|||
;; Then eliminate trivial constraints iteratively.
|
||||
(let ((i 0))
|
||||
(while csts
|
||||
(let ((rhvs (mapcar #'cdr csts))
|
||||
(let ((rhvs (mapcar 'cdr csts))
|
||||
(progress nil))
|
||||
(dolist (cst csts)
|
||||
(unless (memq (car cst) rhvs)
|
||||
|
|
|
|||
|
|
@ -293,15 +293,15 @@
|
|||
;; desirable that viper-pre-command-sentinel is the last hook and
|
||||
;; viper-post-command-sentinel is the first hook.
|
||||
|
||||
(remove-hook 'post-command-hook #'viper-post-command-sentinel)
|
||||
(add-hook 'post-command-hook #'viper-post-command-sentinel)
|
||||
(remove-hook 'pre-command-hook #'viper-pre-command-sentinel)
|
||||
(add-hook 'pre-command-hook #'viper-pre-command-sentinel t)
|
||||
(remove-hook 'post-command-hook 'viper-post-command-sentinel)
|
||||
(add-hook 'post-command-hook 'viper-post-command-sentinel)
|
||||
(remove-hook 'pre-command-hook 'viper-pre-command-sentinel)
|
||||
(add-hook 'pre-command-hook 'viper-pre-command-sentinel t)
|
||||
;; These hooks will be added back if switching to insert/replace mode
|
||||
(remove-hook 'viper-post-command-hooks
|
||||
#'viper-insert-state-post-command-sentinel 'local)
|
||||
'viper-insert-state-post-command-sentinel 'local)
|
||||
(remove-hook 'viper-pre-command-hooks
|
||||
#'viper-insert-state-pre-command-sentinel 'local)
|
||||
'viper-insert-state-pre-command-sentinel 'local)
|
||||
(setq viper-intermediate-command nil)
|
||||
(cond ((eq new-state 'vi-state)
|
||||
(cond ((member viper-current-state '(insert-state replace-state))
|
||||
|
|
@ -344,9 +344,9 @@
|
|||
(viper-move-marker-locally
|
||||
'viper-last-posn-while-in-insert-state (point))
|
||||
(add-hook 'viper-post-command-hooks
|
||||
#'viper-insert-state-post-command-sentinel t 'local)
|
||||
'viper-insert-state-post-command-sentinel t 'local)
|
||||
(add-hook 'viper-pre-command-hooks
|
||||
#'viper-insert-state-pre-command-sentinel t 'local))
|
||||
'viper-insert-state-pre-command-sentinel t 'local))
|
||||
) ; outermost cond
|
||||
|
||||
;; Nothing needs to be done to switch to emacs mode! Just set some
|
||||
|
|
@ -1074,7 +1074,7 @@ as a Meta key and any number of multiple escapes are allowed."
|
|||
;; it is an error.
|
||||
(progn
|
||||
;; new com is (CHAR . OLDCOM)
|
||||
(if (viper-memq-char char '(?# ?\")) (viper--user-error))
|
||||
(if (viper-memq-char char '(?# ?\")) (user-error viper-ViperBell))
|
||||
(setq com (cons char com))
|
||||
(setq cont nil))
|
||||
;; If com is nil we set com as char, and read more. Again, if char is
|
||||
|
|
@ -1093,7 +1093,7 @@ as a Meta key and any number of multiple escapes are allowed."
|
|||
(let ((reg (read-char)))
|
||||
(if (viper-valid-register reg)
|
||||
(setq viper-use-register reg)
|
||||
(viper--user-error))
|
||||
(user-error viper-ViperBell))
|
||||
(setq char (read-char))))
|
||||
(t
|
||||
(setq com char)
|
||||
|
|
@ -1115,7 +1115,7 @@ as a Meta key and any number of multiple escapes are allowed."
|
|||
(viper-regsuffix-command-p char)
|
||||
(viper= char ?!) ; bang command
|
||||
(viper= char ?g) ; the gg command (like G0)
|
||||
(viper--user-error))
|
||||
(user-error viper-ViperBell))
|
||||
(setq cmd-to-exec-at-end
|
||||
(viper-exec-form-in-vi
|
||||
`(key-binding (char-to-string ,char)))))
|
||||
|
|
@ -1149,7 +1149,7 @@ as a Meta key and any number of multiple escapes are allowed."
|
|||
((equal com '(?= . ?=)) (viper-line (cons value ?=)))
|
||||
;; gg acts as G0
|
||||
((equal (car com) ?g) (viper-goto-line 0))
|
||||
(t (viper--user-error)))))
|
||||
(t (user-error viper-ViperBell)))))
|
||||
|
||||
(if cmd-to-exec-at-end
|
||||
(progn
|
||||
|
|
@ -1432,25 +1432,23 @@ as a Meta key and any number of multiple escapes are allowed."
|
|||
(setq viper-intermediate-command 'viper-exec-buffer-search)
|
||||
(viper-search viper-s-string viper-s-forward 1))
|
||||
|
||||
(defvar viper-exec-array
|
||||
(let ((a (make-vector 128 nil)))
|
||||
(defvar viper-exec-array (make-vector 128 nil))
|
||||
|
||||
;; Using a dispatch array allows adding functions like buffer search
|
||||
;; without affecting other functions. Buffer search can now be bound
|
||||
;; to any character.
|
||||
;; Using a dispatch array allows adding functions like buffer search
|
||||
;; without affecting other functions. Buffer search can now be bound
|
||||
;; to any character.
|
||||
|
||||
(aset a ?c 'viper-exec-change)
|
||||
(aset a ?C 'viper-exec-Change)
|
||||
(aset a ?d 'viper-exec-delete)
|
||||
(aset a ?D 'viper-exec-Delete)
|
||||
(aset a ?y 'viper-exec-yank)
|
||||
(aset a ?Y 'viper-exec-Yank)
|
||||
(aset a ?r 'viper-exec-dummy)
|
||||
(aset a ?! 'viper-exec-bang)
|
||||
(aset a ?< 'viper-exec-shift)
|
||||
(aset a ?> 'viper-exec-shift)
|
||||
(aset a ?= 'viper-exec-equals)
|
||||
a))
|
||||
(aset viper-exec-array ?c 'viper-exec-change)
|
||||
(aset viper-exec-array ?C 'viper-exec-Change)
|
||||
(aset viper-exec-array ?d 'viper-exec-delete)
|
||||
(aset viper-exec-array ?D 'viper-exec-Delete)
|
||||
(aset viper-exec-array ?y 'viper-exec-yank)
|
||||
(aset viper-exec-array ?Y 'viper-exec-Yank)
|
||||
(aset viper-exec-array ?r 'viper-exec-dummy)
|
||||
(aset viper-exec-array ?! 'viper-exec-bang)
|
||||
(aset viper-exec-array ?< 'viper-exec-shift)
|
||||
(aset viper-exec-array ?> 'viper-exec-shift)
|
||||
(aset viper-exec-array ?= 'viper-exec-equals)
|
||||
|
||||
|
||||
|
||||
|
|
@ -1589,7 +1587,7 @@ invokes the command before that, etc."
|
|||
(defun viper-undo-sentinel (beg end length)
|
||||
(run-hook-with-args 'viper-undo-functions beg end length))
|
||||
|
||||
(add-hook 'after-change-functions #'viper-undo-sentinel)
|
||||
(add-hook 'after-change-functions 'viper-undo-sentinel)
|
||||
|
||||
;; Hook used in viper-undo
|
||||
(defun viper-after-change-undo-hook (beg end _len)
|
||||
|
|
@ -1599,7 +1597,7 @@ invokes the command before that, etc."
|
|||
;; some other hooks may be changing various text properties in
|
||||
;; the buffer in response to 'undo'; so remove this hook to avoid
|
||||
;; its repeated invocation
|
||||
(remove-hook 'viper-undo-functions #'viper-after-change-undo-hook 'local)
|
||||
(remove-hook 'viper-undo-functions 'viper-after-change-undo-hook 'local)
|
||||
))
|
||||
|
||||
(defun viper-undo ()
|
||||
|
|
@ -1610,7 +1608,7 @@ invokes the command before that, etc."
|
|||
undo-beg-posn undo-end-posn)
|
||||
|
||||
;; the viper-after-change-undo-hook removes itself after the 1st invocation
|
||||
(add-hook 'viper-undo-functions #'viper-after-change-undo-hook nil 'local)
|
||||
(add-hook 'viper-undo-functions 'viper-after-change-undo-hook nil 'local)
|
||||
|
||||
(undo-start)
|
||||
(undo-more 2)
|
||||
|
|
@ -1882,8 +1880,8 @@ Undo previous insertion and inserts new."
|
|||
;;; Minibuffer business
|
||||
|
||||
(defsubst viper-set-minibuffer-style ()
|
||||
(add-hook 'minibuffer-setup-hook #'viper-minibuffer-setup-sentinel)
|
||||
(add-hook 'post-command-hook #'viper-minibuffer-post-command-hook))
|
||||
(add-hook 'minibuffer-setup-hook 'viper-minibuffer-setup-sentinel)
|
||||
(add-hook 'post-command-hook 'viper-minibuffer-post-command-hook))
|
||||
|
||||
|
||||
(defun viper-minibuffer-setup-sentinel ()
|
||||
|
|
@ -2229,22 +2227,22 @@ problems."
|
|||
viper-sitting-in-replace t
|
||||
viper-replace-chars-to-delete 0)
|
||||
(add-hook
|
||||
'viper-after-change-functions #'viper-replace-mode-spy-after t 'local)
|
||||
'viper-after-change-functions 'viper-replace-mode-spy-after t 'local)
|
||||
(add-hook
|
||||
'viper-before-change-functions #'viper-replace-mode-spy-before t 'local)
|
||||
'viper-before-change-functions 'viper-replace-mode-spy-before t 'local)
|
||||
;; this will get added repeatedly, but no harm
|
||||
(add-hook 'after-change-functions #'viper-after-change-sentinel t)
|
||||
(add-hook 'before-change-functions #'viper-before-change-sentinel t)
|
||||
(add-hook 'after-change-functions 'viper-after-change-sentinel t)
|
||||
(add-hook 'before-change-functions 'viper-before-change-sentinel t)
|
||||
(viper-move-marker-locally
|
||||
'viper-last-posn-in-replace-region (viper-replace-start))
|
||||
(add-hook
|
||||
'viper-post-command-hooks #'viper-replace-state-post-command-sentinel
|
||||
'viper-post-command-hooks 'viper-replace-state-post-command-sentinel
|
||||
t 'local)
|
||||
(add-hook
|
||||
'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel t 'local)
|
||||
'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel t 'local)
|
||||
;; guard against a smarty who switched from R-replace to normal replace
|
||||
(remove-hook
|
||||
'viper-post-command-hooks #'viper-R-state-post-command-sentinel 'local)
|
||||
'viper-post-command-hooks 'viper-R-state-post-command-sentinel 'local)
|
||||
(if overwrite-mode (overwrite-mode -1))
|
||||
)
|
||||
|
||||
|
|
@ -2318,13 +2316,13 @@ problems."
|
|||
;; Don't delete anything if current point is past the end of the overlay.
|
||||
(defun viper-finish-change ()
|
||||
(remove-hook
|
||||
'viper-after-change-functions #'viper-replace-mode-spy-after 'local)
|
||||
'viper-after-change-functions 'viper-replace-mode-spy-after 'local)
|
||||
(remove-hook
|
||||
'viper-before-change-functions #'viper-replace-mode-spy-before 'local)
|
||||
'viper-before-change-functions 'viper-replace-mode-spy-before 'local)
|
||||
(remove-hook
|
||||
'viper-post-command-hooks #'viper-replace-state-post-command-sentinel 'local)
|
||||
'viper-post-command-hooks 'viper-replace-state-post-command-sentinel 'local)
|
||||
(remove-hook
|
||||
'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel 'local)
|
||||
'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel 'local)
|
||||
(viper-restore-cursor-color 'after-replace-mode)
|
||||
(setq viper-sitting-in-replace nil) ; just in case we'll need to know it
|
||||
(save-excursion
|
||||
|
|
@ -2354,21 +2352,21 @@ problems."
|
|||
|
||||
(defun viper-finish-R-mode ()
|
||||
(remove-hook
|
||||
'viper-post-command-hooks #'viper-R-state-post-command-sentinel 'local)
|
||||
'viper-post-command-hooks 'viper-R-state-post-command-sentinel 'local)
|
||||
(remove-hook
|
||||
'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel 'local)
|
||||
'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel 'local)
|
||||
(viper-downgrade-to-insert))
|
||||
|
||||
(defun viper-start-R-mode ()
|
||||
;; Leave arg as 1, not t: XEmacs insists that it must be a pos number
|
||||
(overwrite-mode 1)
|
||||
(add-hook
|
||||
'viper-post-command-hooks #'viper-R-state-post-command-sentinel t 'local)
|
||||
'viper-post-command-hooks 'viper-R-state-post-command-sentinel t 'local)
|
||||
(add-hook
|
||||
'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel t 'local)
|
||||
'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel t 'local)
|
||||
;; guard against a smarty who switched from R-replace to normal replace
|
||||
(remove-hook
|
||||
'viper-post-command-hooks #'viper-replace-state-post-command-sentinel 'local)
|
||||
'viper-post-command-hooks 'viper-replace-state-post-command-sentinel 'local)
|
||||
)
|
||||
|
||||
|
||||
|
|
@ -2543,9 +2541,9 @@ On reaching end of line, stop and signal error."
|
|||
;; the forward motion before the 'viper-execute-com', but, of
|
||||
;; course, 'dl' doesn't work on an empty line, so we have to
|
||||
;; catch that condition before 'viper-execute-com'
|
||||
(if (and (eolp) (bolp)) (viper--user-error) (forward-char val))
|
||||
(if (and (eolp) (bolp)) (user-error viper-ViperBell) (forward-char val))
|
||||
(if com (viper-execute-com 'viper-forward-char val com))
|
||||
(if (eolp) (progn (backward-char 1) (viper--user-error))))
|
||||
(if (eolp) (progn (backward-char 1) (user-error viper-ViperBell))))
|
||||
(forward-char val)
|
||||
(if com (viper-execute-com 'viper-forward-char val com)))))
|
||||
|
||||
|
|
@ -2559,7 +2557,7 @@ On reaching beginning of line, stop and signal error."
|
|||
(if com (viper-move-marker-locally 'viper-com-point (point)))
|
||||
(if viper-ex-style-motion
|
||||
(progn
|
||||
(if (bolp) (viper--user-error) (backward-char val))
|
||||
(if (bolp) (user-error viper-ViperBell) (backward-char val))
|
||||
(if com (viper-execute-com 'viper-backward-char val com)))
|
||||
(backward-char val)
|
||||
(if com (viper-execute-com 'viper-backward-char val com)))))
|
||||
|
|
@ -2876,7 +2874,7 @@ On reaching beginning of line, stop and signal error."
|
|||
(if com (viper-execute-com 'viper-goto-col val com))
|
||||
(save-excursion
|
||||
(end-of-line)
|
||||
(if (> val (current-column)) (viper--user-error)))
|
||||
(if (> val (current-column)) (user-error viper-ViperBell)))
|
||||
))
|
||||
|
||||
|
||||
|
|
@ -3003,7 +3001,7 @@ If point is on a widget or a button, simulate clicking on that widget/button."
|
|||
;; If FORWARD then search is forward, otherwise backward. OFFSET is used to
|
||||
;; adjust point after search.
|
||||
(defun viper-find-char (arg char forward offset)
|
||||
(or (char-or-string-p char) (viper--user-error))
|
||||
(or (char-or-string-p char) (user-error viper-ViperBell))
|
||||
(let ((arg (if forward arg (- arg)))
|
||||
(cmd (if (eq viper-intermediate-command 'viper-repeat)
|
||||
(nth 5 viper-d-com)
|
||||
|
|
@ -3337,7 +3335,7 @@ controlled by the sign of prefix numeric value."
|
|||
(if com (viper-move-marker-locally 'viper-com-point (point)))
|
||||
(backward-sexp 1)
|
||||
(if com (viper-execute-com 'viper-paren-match nil com)))
|
||||
(t (viper--user-error))))))
|
||||
(t (user-error viper-ViperBell))))))
|
||||
|
||||
(defun viper-toggle-parse-sexp-ignore-comments ()
|
||||
(interactive)
|
||||
|
|
@ -3908,7 +3906,7 @@ Null string will repeat previous search."
|
|||
(let ((reg viper-use-register))
|
||||
(setq viper-use-register nil)
|
||||
(error viper-EmptyRegister reg))
|
||||
(viper--user-error)))
|
||||
(user-error viper-ViperBell)))
|
||||
(setq viper-use-register nil)
|
||||
(if (viper-end-with-a-newline-p text)
|
||||
(progn
|
||||
|
|
@ -3958,7 +3956,7 @@ Null string will repeat previous search."
|
|||
(let ((reg viper-use-register))
|
||||
(setq viper-use-register nil)
|
||||
(error viper-EmptyRegister reg))
|
||||
(viper--user-error)))
|
||||
(user-error viper-ViperBell)))
|
||||
(setq viper-use-register nil)
|
||||
(if (viper-end-with-a-newline-p text) (beginning-of-line))
|
||||
(viper-set-destructive-command
|
||||
|
|
@ -4003,7 +4001,7 @@ Null string will repeat previous search."
|
|||
(> val (viper-chars-in-region (point) (viper-line-pos 'end))))
|
||||
(setq val (viper-chars-in-region (point) (viper-line-pos 'end))))
|
||||
(if (and viper-ex-style-motion (eolp))
|
||||
(if (bolp) (viper--user-error) (setq val 0))) ; not bol---simply back 1 ch
|
||||
(if (bolp) (user-error viper-ViperBell) (setq val 0))) ; not bol---simply back 1 ch
|
||||
(save-excursion
|
||||
(viper-forward-char-carefully val)
|
||||
(setq end-del-pos (point)))
|
||||
|
|
@ -4273,7 +4271,7 @@ and regexp replace."
|
|||
((viper= char ?,) (viper-cycle-through-mark-ring))
|
||||
((viper= char ?^) (push-mark viper-saved-mark t t))
|
||||
((viper= char ?D) (mark-defun))
|
||||
(t (viper--user-error))
|
||||
(t (user-error viper-ViperBell))
|
||||
)))
|
||||
|
||||
;; Algorithm: If first invocation of this command save mark on ring, goto
|
||||
|
|
@ -4372,7 +4370,7 @@ One can use \\=`\\=` and \\='\\=' to temporarily jump 1 step back."
|
|||
(switch-to-buffer buff)
|
||||
(goto-char viper-com-point)
|
||||
(viper-change-state-to-vi)
|
||||
(viper--user-error)))))
|
||||
(user-error viper-ViperBell)))))
|
||||
((and (not skip-white) (viper= char ?`))
|
||||
(if com (viper-move-marker-locally 'viper-com-point (point)))
|
||||
(if (and (viper-same-line (point) viper-last-jump)
|
||||
|
|
|
|||
|
|
@ -1239,7 +1239,7 @@ reversed."
|
|||
(read-string "[Hit return to confirm] ")
|
||||
(quit
|
||||
(save-excursion (kill-buffer " *delete text*"))
|
||||
(viper--user-error)))
|
||||
(user-error viper-ViperBell)))
|
||||
(save-excursion (kill-buffer " *delete text*")))
|
||||
(if ex-buffer
|
||||
(cond ((viper-valid-register ex-buffer '(Letter))
|
||||
|
|
|
|||
|
|
@ -64,8 +64,6 @@
|
|||
(define-obsolete-function-alias 'viper-iconify
|
||||
'iconify-or-deiconify-frame "27.1")
|
||||
|
||||
(defun viper--user-error () (user-error "Viper bell"))
|
||||
(defun viper--user-error () (user-error "Viper bell"))
|
||||
|
||||
;; CHAR is supposed to be a char or an integer (positive or negative)
|
||||
;; LIST is a list of chars, nil, and negative numbers
|
||||
|
|
|
|||
|
|
@ -536,17 +536,17 @@ keybindings will not do anything useful."
|
|||
((when (boundp 'erc-track-when-inactive)
|
||||
(if erc-track-when-inactive
|
||||
(progn
|
||||
(add-hook 'window-configuration-change-hook #'erc-user-is-active)
|
||||
(add-hook 'erc-send-completed-hook #'erc-user-is-active)
|
||||
(add-hook 'erc-server-001-functions #'erc-user-is-active))
|
||||
(add-hook 'window-configuration-change-hook 'erc-user-is-active)
|
||||
(add-hook 'erc-send-completed-hook 'erc-user-is-active)
|
||||
(add-hook 'erc-server-001-functions 'erc-user-is-active))
|
||||
(erc-track-add-to-mode-line erc-track-position-in-mode-line)
|
||||
(erc-update-mode-line)
|
||||
(add-hook 'window-configuration-change-hook
|
||||
#'erc-window-configuration-change)
|
||||
(add-hook 'erc-insert-post-hook #'erc-track-modified-channels)
|
||||
(add-hook 'erc-disconnected-hook #'erc-modified-channels-update))
|
||||
'erc-window-configuration-change)
|
||||
(add-hook 'erc-insert-post-hook 'erc-track-modified-channels)
|
||||
(add-hook 'erc-disconnected-hook 'erc-modified-channels-update))
|
||||
;; enable the tracking keybindings
|
||||
(add-hook 'erc-connect-pre-hook #'erc-track-minor-mode-maybe)
|
||||
(add-hook 'erc-connect-pre-hook 'erc-track-minor-mode-maybe)
|
||||
(erc-track-minor-mode-maybe)))
|
||||
;; Disable:
|
||||
((when (boundp 'erc-track-when-inactive)
|
||||
|
|
@ -554,15 +554,14 @@ keybindings will not do anything useful."
|
|||
(if erc-track-when-inactive
|
||||
(progn
|
||||
(remove-hook 'window-configuration-change-hook
|
||||
#'erc-user-is-active)
|
||||
(remove-hook 'erc-send-completed-hook #'erc-user-is-active)
|
||||
(remove-hook 'erc-server-001-functions #'erc-user-is-active)
|
||||
;; FIXME: Never added!?
|
||||
(remove-hook 'erc-timer-hook #'erc-user-is-active))
|
||||
'erc-user-is-active)
|
||||
(remove-hook 'erc-send-completed-hook 'erc-user-is-active)
|
||||
(remove-hook 'erc-server-001-functions 'erc-user-is-active)
|
||||
(remove-hook 'erc-timer-hook 'erc-user-is-active))
|
||||
(remove-hook 'window-configuration-change-hook
|
||||
#'erc-window-configuration-change)
|
||||
(remove-hook 'erc-disconnected-hook #'erc-modified-channels-update)
|
||||
(remove-hook 'erc-insert-post-hook #'erc-track-modified-channels))
|
||||
'erc-window-configuration-change)
|
||||
(remove-hook 'erc-disconnected-hook 'erc-modified-channels-update)
|
||||
(remove-hook 'erc-insert-post-hook 'erc-track-modified-channels))
|
||||
;; disable the tracking keybindings
|
||||
(remove-hook 'erc-connect-pre-hook 'erc-track-minor-mode-maybe)
|
||||
(when erc-track-minor-mode
|
||||
|
|
|
|||
|
|
@ -5453,7 +5453,7 @@ This returns non-nil only if we actually send anything."
|
|||
;; obsolete, and when it's finally removed, this binding should
|
||||
;; also be removed.
|
||||
(with-suppressed-warnings ((lexical str))
|
||||
(defvar str)) ;FIXME: Obey the "erc-" prefix convention.
|
||||
(defvar str))
|
||||
(let ((str input)
|
||||
(erc-insert-this t)
|
||||
(erc-send-this t)
|
||||
|
|
|
|||
|
|
@ -306,7 +306,8 @@ Prepend remote identification of `default-directory', if any."
|
|||
(setq m (cdr m))))
|
||||
l)
|
||||
(define-obsolete-function-alias
|
||||
'eshell-uniqify-list #'eshell-uniquify-list "27.1")
|
||||
'eshell-uniqify-list
|
||||
'eshell-uniquify-list "27.1")
|
||||
|
||||
(defun eshell-stringify (object)
|
||||
"Convert OBJECT into a string value."
|
||||
|
|
@ -325,11 +326,11 @@ Prepend remote identification of `default-directory', if any."
|
|||
|
||||
(defsubst eshell-stringify-list (args)
|
||||
"Convert each element of ARGS into a string value."
|
||||
(mapcar #'eshell-stringify args))
|
||||
(mapcar 'eshell-stringify args))
|
||||
|
||||
(defsubst eshell-flatten-and-stringify (&rest args)
|
||||
"Flatten and stringify all of the ARGS into a single string."
|
||||
(mapconcat #'eshell-stringify (flatten-tree args) " "))
|
||||
(mapconcat 'eshell-stringify (flatten-tree args) " "))
|
||||
|
||||
(defsubst eshell-directory-files (regexp &optional directory)
|
||||
"Return a list of files in the given DIRECTORY matching REGEXP."
|
||||
|
|
@ -525,7 +526,7 @@ Unless optional argument INPLACE is non-nil, return a new string."
|
|||
|
||||
(defsubst eshell-copy-environment ()
|
||||
"Return an unrelated copy of `process-environment'."
|
||||
(mapcar #'concat process-environment))
|
||||
(mapcar 'concat process-environment))
|
||||
|
||||
(defun eshell-subgroups (groupsym)
|
||||
"Return all of the subgroups of GROUPSYM."
|
||||
|
|
|
|||
142
lisp/follow.el
142
lisp/follow.el
|
|
@ -117,7 +117,7 @@
|
|||
;; `follow-mode'.
|
||||
;;
|
||||
;; Example:
|
||||
;; (add-hook 'follow-mode-hook #'my-follow-mode-hook)
|
||||
;; (add-hook 'follow-mode-hook 'my-follow-mode-hook)
|
||||
;;
|
||||
;; (defun my-follow-mode-hook ()
|
||||
;; (define-key follow-mode-map "\C-ca" 'your-favorite-function)
|
||||
|
|
@ -307,8 +307,8 @@ are \" Fw\", or simply \"\"."
|
|||
:group 'follow
|
||||
:set (lambda (symbol value)
|
||||
(if value
|
||||
(add-hook 'find-file-hook #'follow-find-file-hook t)
|
||||
(remove-hook 'find-file-hook #'follow-find-file-hook))
|
||||
(add-hook 'find-file-hook 'follow-find-file-hook t)
|
||||
(remove-hook 'find-file-hook 'follow-find-file-hook))
|
||||
(set-default symbol value)))
|
||||
|
||||
(defcustom follow-hide-ghost-cursors t ; Maybe this should be nil.
|
||||
|
|
@ -370,7 +370,7 @@ This is typically set by explicit scrolling commands.")
|
|||
(defsubst follow-debug-message (&rest args)
|
||||
"Like `message', but only active when `follow-debug' is non-nil."
|
||||
(if (and (boundp 'follow-debug) follow-debug)
|
||||
(apply #'message args)))
|
||||
(apply 'message args)))
|
||||
|
||||
;;; Cache
|
||||
|
||||
|
|
@ -428,28 +428,27 @@ Keys specific to Follow mode:
|
|||
:keymap follow-mode-map
|
||||
(if follow-mode
|
||||
(progn
|
||||
(add-hook 'compilation-filter-hook
|
||||
#'follow-align-compilation-windows t t)
|
||||
(add-function :before pre-redisplay-function #'follow-pre-redisplay-function)
|
||||
(add-hook 'window-size-change-functions #'follow-window-size-change t)
|
||||
(add-hook 'after-change-functions #'follow-after-change nil t)
|
||||
(add-hook 'isearch-update-post-hook #'follow-post-command-hook nil t)
|
||||
(add-hook 'replace-update-post-hook #'follow-post-command-hook nil t)
|
||||
(add-hook 'ispell-update-post-hook #'follow-post-command-hook nil t)
|
||||
(add-hook 'compilation-filter-hook 'follow-align-compilation-windows t t)
|
||||
(add-function :before pre-redisplay-function 'follow-pre-redisplay-function)
|
||||
(add-hook 'window-size-change-functions 'follow-window-size-change t)
|
||||
(add-hook 'after-change-functions 'follow-after-change nil t)
|
||||
(add-hook 'isearch-update-post-hook 'follow-post-command-hook nil t)
|
||||
(add-hook 'replace-update-post-hook 'follow-post-command-hook nil t)
|
||||
(add-hook 'ispell-update-post-hook 'follow-post-command-hook nil t)
|
||||
|
||||
(when isearch-lazy-highlight
|
||||
(setq-local isearch-lazy-highlight 'all-windows))
|
||||
(when follow-hide-ghost-cursors
|
||||
(setq-local cursor-in-non-selected-windows nil))
|
||||
|
||||
(setq window-group-start-function #'follow-window-start)
|
||||
(setq window-group-end-function #'follow-window-end)
|
||||
(setq set-window-group-start-function #'follow-set-window-start)
|
||||
(setq recenter-window-group-function #'follow-recenter)
|
||||
(setq window-group-start-function 'follow-window-start)
|
||||
(setq window-group-end-function 'follow-window-end)
|
||||
(setq set-window-group-start-function 'follow-set-window-start)
|
||||
(setq recenter-window-group-function 'follow-recenter)
|
||||
(setq pos-visible-in-window-group-p-function
|
||||
#'follow-pos-visible-in-window-p)
|
||||
(setq selected-window-group-function #'follow-all-followers)
|
||||
(setq move-to-window-group-line-function #'follow-move-to-window-line))
|
||||
'follow-pos-visible-in-window-p)
|
||||
(setq selected-window-group-function 'follow-all-followers)
|
||||
(setq move-to-window-group-line-function 'follow-move-to-window-line))
|
||||
|
||||
;; Remove globally-installed hook functions only if there is no
|
||||
;; other Follow mode buffer.
|
||||
|
|
@ -459,8 +458,8 @@ Keys specific to Follow mode:
|
|||
(setq following (buffer-local-value 'follow-mode (car buffers))
|
||||
buffers (cdr buffers)))
|
||||
(unless following
|
||||
(remove-function pre-redisplay-function #'follow-pre-redisplay-function)
|
||||
(remove-hook 'window-size-change-functions #'follow-window-size-change)))
|
||||
(remove-function pre-redisplay-function 'follow-pre-redisplay-function)
|
||||
(remove-hook 'window-size-change-functions 'follow-window-size-change)))
|
||||
|
||||
(kill-local-variable 'move-to-window-group-line-function)
|
||||
(kill-local-variable 'selected-window-group-function)
|
||||
|
|
@ -472,11 +471,11 @@ Keys specific to Follow mode:
|
|||
|
||||
(kill-local-variable 'cursor-in-non-selected-windows)
|
||||
|
||||
(remove-hook 'ispell-update-post-hook #'follow-post-command-hook t)
|
||||
(remove-hook 'replace-update-post-hook #'follow-post-command-hook t)
|
||||
(remove-hook 'isearch-update-post-hook #'follow-post-command-hook t)
|
||||
(remove-hook 'after-change-functions #'follow-after-change t)
|
||||
(remove-hook 'compilation-filter-hook #'follow-align-compilation-windows t)))
|
||||
(remove-hook 'ispell-update-post-hook 'follow-post-command-hook t)
|
||||
(remove-hook 'replace-update-post-hook 'follow-post-command-hook t)
|
||||
(remove-hook 'isearch-update-post-hook 'follow-post-command-hook t)
|
||||
(remove-hook 'after-change-functions 'follow-after-change t)
|
||||
(remove-hook 'compilation-filter-hook 'follow-align-compilation-windows t)))
|
||||
|
||||
(defun follow-find-file-hook ()
|
||||
"Find-file hook for Follow mode. See the variable `follow-auto'."
|
||||
|
|
@ -1052,16 +1051,16 @@ returned by `follow-windows-start-end'."
|
|||
(defun follow-select-if-visible (dest win-start-end)
|
||||
"Select and return a window, if DEST is visible in it.
|
||||
Return the selected window."
|
||||
(let (win)
|
||||
(let (win wse)
|
||||
(while (and (not win) win-start-end)
|
||||
;; Don't select a window that was just moved. This makes it
|
||||
;; possible to later select the last window after a
|
||||
;; `end-of-buffer' command.
|
||||
(let ((wse (car win-start-end)))
|
||||
(when (follow-pos-visible dest (car wse) win-start-end)
|
||||
(setq win (car wse))
|
||||
(select-window win))
|
||||
(setq win-start-end (cdr win-start-end))))
|
||||
(setq wse (car win-start-end))
|
||||
(when (follow-pos-visible dest (car wse) win-start-end)
|
||||
(setq win (car wse))
|
||||
(select-window win))
|
||||
(setq win-start-end (cdr win-start-end)))
|
||||
win))
|
||||
|
||||
;; Lets select a window showing the end. Make sure we only select it if
|
||||
|
|
@ -1218,29 +1217,29 @@ should be a member of WINDOWS, starts at position START."
|
|||
(setq win (or win (selected-window)))
|
||||
(setq start (or start (window-start win)))
|
||||
(save-excursion
|
||||
;; Always calculate what happens when no line is displayed in the first
|
||||
;; window. (The `previous' res is needed below!)
|
||||
(goto-char guess)
|
||||
(vertical-motion 0 (car windows))
|
||||
(let ((res (point))
|
||||
done)
|
||||
(let (done win-start res opoint)
|
||||
;; Always calculate what happens when no line is displayed in the first
|
||||
;; window. (The `previous' res is needed below!)
|
||||
(goto-char guess)
|
||||
(vertical-motion 0 (car windows))
|
||||
(setq res (point))
|
||||
(while (not done)
|
||||
(let ((opoint (point)))
|
||||
(if (not (= (vertical-motion -1 (car windows)) -1))
|
||||
;; Hit roof!
|
||||
(setq done t res (point-min))
|
||||
(let ((win-start (follow-calc-win-start windows (point) win)))
|
||||
(cond ((>= (point) opoint)
|
||||
;; In some pathological cases, vertical-motion may
|
||||
;; return -1 even though point has not decreased. In
|
||||
;; that case, avoid looping forever.
|
||||
(setq done t res (point)))
|
||||
((= win-start start) ; Perfect match, use this value
|
||||
(setq done t res (point)))
|
||||
((< win-start start) ; Walked to far, use previous result
|
||||
(setq done t))
|
||||
(t ; Store result for next iteration
|
||||
(setq res (point))))))))
|
||||
(setq opoint (point))
|
||||
(if (not (= (vertical-motion -1 (car windows)) -1))
|
||||
;; Hit roof!
|
||||
(setq done t res (point-min))
|
||||
(setq win-start (follow-calc-win-start windows (point) win))
|
||||
(cond ((>= (point) opoint)
|
||||
;; In some pathological cases, vertical-motion may
|
||||
;; return -1 even though point has not decreased. In
|
||||
;; that case, avoid looping forever.
|
||||
(setq done t res (point)))
|
||||
((= win-start start) ; Perfect match, use this value
|
||||
(setq done t res (point)))
|
||||
((< win-start start) ; Walked to far, use previous result
|
||||
(setq done t))
|
||||
(t ; Store result for next iteration
|
||||
(setq res (point))))))
|
||||
res)))
|
||||
|
||||
;;; Avoid tail recenter
|
||||
|
|
@ -1317,8 +1316,6 @@ follow-mode is not necessarily enabled in this buffer.")
|
|||
;; Work in the selected window, not in the current buffer.
|
||||
(with-current-buffer (window-buffer win)
|
||||
(unless (and (symbolp this-command)
|
||||
;; FIXME: Why not compare buffer-modified-tick and
|
||||
;; selected-window to their old value, instead?
|
||||
(get this-command 'follow-mode-use-cache))
|
||||
(setq follow-windows-start-end-cache nil))
|
||||
(follow-adjust-window win)))))
|
||||
|
|
@ -1326,7 +1323,7 @@ follow-mode is not necessarily enabled in this buffer.")
|
|||
;; NOTE: to debug follow-mode with edebug, it is helpful to add
|
||||
;; `follow-post-command-hook' to `post-command-hook' temporarily. Do
|
||||
;; this locally to the target buffer with, say,:
|
||||
;; M-: (add-hook 'post-command-hook #'follow-post-command-hook t t)
|
||||
;; M-: (add-hook 'post-command-hook 'follow-post-command-hook t t)
|
||||
;; .
|
||||
|
||||
(defun follow-adjust-window (win)
|
||||
|
|
@ -1514,12 +1511,15 @@ follow-mode is not necessarily enabled in this buffer.")
|
|||
"Make a highlighted region stretching multiple windows look good."
|
||||
(let* ((all (follow-split-followers windows win))
|
||||
(pred (car all))
|
||||
(succ (cdr all)))
|
||||
(dolist (w pred)
|
||||
(let ((data (assq w win-start-end)))
|
||||
(set-window-point w (max (nth 1 data) (- (nth 2 data) 1)))))
|
||||
(dolist (w succ)
|
||||
(set-window-point w (nth 1 (assq w win-start-end))))))
|
||||
(succ (cdr all))
|
||||
data)
|
||||
(while pred
|
||||
(setq data (assq (car pred) win-start-end))
|
||||
(set-window-point (car pred) (max (nth 1 data) (- (nth 2 data) 1)))
|
||||
(setq pred (cdr pred)))
|
||||
(while succ
|
||||
(set-window-point (car succ) (nth 1 (assq (car succ) win-start-end)))
|
||||
(setq succ (cdr succ)))))
|
||||
|
||||
;;; Scroll bar
|
||||
|
||||
|
|
@ -1616,7 +1616,7 @@ follow-mode is not necessarily enabled in this buffer.")
|
|||
(select-window picked-window 'norecord)))
|
||||
(select-frame orig-frame)))))
|
||||
|
||||
(add-hook 'window-scroll-functions #'follow-avoid-tail-recenter t)
|
||||
(add-hook 'window-scroll-functions 'follow-avoid-tail-recenter t)
|
||||
|
||||
;;; Low level window start and end.
|
||||
|
||||
|
|
@ -1690,8 +1690,9 @@ of the actual window containing it. The remaining elements are
|
|||
omitted if the character after POS is fully visible; otherwise, RTOP
|
||||
and RBOT are the number of pixels off-window at the top and bottom of
|
||||
the screen line (\"row\") containing POS, ROWH is the visible height
|
||||
of that row, and VPOS is the row number (zero-based)."
|
||||
(let* ((windows (follow-all-followers window)))
|
||||
of that row, and VPOS is the row number \(zero-based)."
|
||||
(let* ((windows (follow-all-followers window))
|
||||
(last (car (last windows))))
|
||||
(when follow-start-end-invalid
|
||||
(follow-redisplay windows (car windows)))
|
||||
(let* ((cache (follow-windows-start-end windows))
|
||||
|
|
@ -1702,9 +1703,10 @@ of that row, and VPOS is the row number (zero-based)."
|
|||
last-elt
|
||||
(setq our-pos (or pos (point)))
|
||||
(catch 'element
|
||||
(dolist (ce cache)
|
||||
(when (< our-pos (nth 2 ce))
|
||||
(throw 'element ce)))
|
||||
(while cache
|
||||
(when (< our-pos (nth 2 (car cache)))
|
||||
(throw 'element (car cache)))
|
||||
(setq cache (cdr cache)))
|
||||
last-elt)))
|
||||
(pos-visible-in-window-p our-pos (car pertinent-elt) partially))))
|
||||
|
||||
|
|
@ -1718,7 +1720,7 @@ zero means top of the first window in the group, negative means
|
|||
(start-end (follow-windows-start-end windows))
|
||||
(rev-start-end (reverse start-end))
|
||||
(lines 0)
|
||||
elt count)
|
||||
middle-window elt count)
|
||||
(select-window
|
||||
(cond
|
||||
((null arg)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; format-spec.el --- functions for formatting arbitrary formatting strings -*- lexical-binding:t -*-
|
||||
;;; format-spec.el --- functions for formatting arbitrary formatting strings
|
||||
|
||||
;; Copyright (C) 1999-2019 Free Software Foundation, Inc.
|
||||
|
||||
|
|
|
|||
|
|
@ -26,7 +26,6 @@
|
|||
|
||||
;;; Code:
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
(eval-when-compile (require 'subr-x)) ;For string-trim-right
|
||||
|
||||
(cl-defgeneric frame-creation-function (params)
|
||||
"Method for window-system dependent functions to create a new frame.
|
||||
|
|
@ -2502,34 +2501,14 @@ command starts, by installing a pre-command hook."
|
|||
(when (and (> blink-cursor-blinks 0)
|
||||
(<= (* 2 blink-cursor-blinks) blink-cursor-blinks-done))
|
||||
(blink-cursor-suspend)
|
||||
(add-hook 'post-command-hook #'blink-cursor-check))
|
||||
;; FIXME: Under TTYs, apparently redisplay only obeys internal-show-cursor
|
||||
;; when there is something else to update on the screen. This is arguably
|
||||
;; a bug, but in the meantime we can circumvent it here by causing an
|
||||
;; artificial update which thus "forces" a cursor update.
|
||||
(when (null window-system)
|
||||
(let* ((message-log-max nil)
|
||||
(msg (current-message))
|
||||
;; Construct a dummy temp message different from the current one.
|
||||
;; This message usually flashes by too quickly to be visible, but
|
||||
;; occasionally it can be noticed, so make it "inconspicuous".
|
||||
;; Not too "inconspicuous", tho: just adding or removing a SPC at the
|
||||
;; end doesn't cause an update, for example.
|
||||
(dummymsg (concat (if (> (length msg) 40)
|
||||
(let ((msg (string-trim-right msg)))
|
||||
(if (> (length msg) 2)
|
||||
(substring msg 0 -2)
|
||||
msg))
|
||||
msg) "-")))
|
||||
(message "%s" dummymsg)
|
||||
(if msg (message "%s" msg) (message nil)))))
|
||||
(add-hook 'post-command-hook 'blink-cursor-check)))
|
||||
|
||||
(defun blink-cursor-end ()
|
||||
"Stop cursor blinking.
|
||||
This is installed as a pre-command hook by `blink-cursor-start'.
|
||||
When run, it cancels the timer `blink-cursor-timer' and removes
|
||||
itself as a pre-command hook."
|
||||
(remove-hook 'pre-command-hook #'blink-cursor-end)
|
||||
(remove-hook 'pre-command-hook 'blink-cursor-end)
|
||||
(internal-show-cursor nil t)
|
||||
(when blink-cursor-timer
|
||||
(cancel-timer blink-cursor-timer)
|
||||
|
|
@ -2548,7 +2527,15 @@ frame receives focus."
|
|||
(defun blink-cursor--should-blink ()
|
||||
"Determine whether we should be blinking.
|
||||
Returns whether we have any focused non-TTY frame."
|
||||
blink-cursor-mode)
|
||||
(and blink-cursor-mode
|
||||
(let ((frame-list (frame-list))
|
||||
(any-graphical-focused nil))
|
||||
(while frame-list
|
||||
(let ((frame (pop frame-list)))
|
||||
(when (and (display-graphic-p frame) (frame-focus-state frame))
|
||||
(setf any-graphical-focused t)
|
||||
(setf frame-list nil))))
|
||||
any-graphical-focused)))
|
||||
|
||||
(defun blink-cursor-check ()
|
||||
"Check if cursor blinking shall be restarted.
|
||||
|
|
@ -2557,7 +2544,7 @@ stopped by `blink-cursor-suspend'. Internally calls
|
|||
`blink-cursor--should-blink' and returns its result."
|
||||
(let ((should-blink (blink-cursor--should-blink)))
|
||||
(when (and should-blink (not blink-cursor-idle-timer))
|
||||
(remove-hook 'post-command-hook #'blink-cursor-check)
|
||||
(remove-hook 'post-command-hook 'blink-cursor-check)
|
||||
(blink-cursor--start-idle-timer))
|
||||
should-blink))
|
||||
|
||||
|
|
|
|||
|
|
@ -1615,7 +1615,7 @@ It is a string, such as \"PGP\". If nil, ask user."
|
|||
:group 'gnus-article
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom gnus-blocked-images #'gnus-block-private-groups
|
||||
(defcustom gnus-blocked-images 'gnus-block-private-groups
|
||||
"Images that have URLs matching this regexp will be blocked.
|
||||
Note that the main reason external images are included in HTML
|
||||
emails (these days) is to allow tracking whether you've read the
|
||||
|
|
@ -2693,7 +2693,7 @@ If READ-CHARSET, ask for a coding system."
|
|||
"Format an HTML article."
|
||||
(interactive)
|
||||
(let ((handles nil)
|
||||
(inhibit-read-only t))
|
||||
(buffer-read-only nil))
|
||||
(when (gnus-buffer-live-p gnus-original-article-buffer)
|
||||
(with-current-buffer gnus-original-article-buffer
|
||||
(setq handles (mm-dissect-buffer t t))))
|
||||
|
|
@ -4302,67 +4302,71 @@ If variable `gnus-use-long-file-name' is non-nil, it is
|
|||
(canlock-verify gnus-original-article-buffer)))
|
||||
|
||||
(eval-and-compile
|
||||
(defmacro gnus-art-defun (gnus-fun &optional article-fun)
|
||||
"Define GNUS-FUN as a function that runs ARTICLE-FUN in the article buffer."
|
||||
(unless article-fun
|
||||
(if (not (string-match "\\`gnus-" (symbol-name gnus-fun)))
|
||||
(error "Can't guess article-fun argument")
|
||||
(setq article-fun (intern (substring (symbol-name gnus-fun)
|
||||
(match-end 0))))))
|
||||
`(defun ,gnus-fun (&optional interactive &rest args)
|
||||
,(format "Run `%s' in the article buffer." article-fun)
|
||||
(interactive (list t))
|
||||
(with-current-buffer gnus-article-buffer
|
||||
(if interactive
|
||||
(call-interactively ',article-fun)
|
||||
(apply #',article-fun args))))))
|
||||
(gnus-art-defun gnus-article-hide-headers)
|
||||
(gnus-art-defun gnus-article-verify-x-pgp-sig)
|
||||
(gnus-art-defun gnus-article-verify-cancel-lock)
|
||||
(gnus-art-defun gnus-article-hide-boring-headers)
|
||||
(gnus-art-defun gnus-article-treat-overstrike)
|
||||
(gnus-art-defun gnus-article-treat-ansi-sequences)
|
||||
(gnus-art-defun gnus-article-fill-long-lines)
|
||||
(gnus-art-defun gnus-article-capitalize-sentences)
|
||||
(gnus-art-defun gnus-article-remove-cr)
|
||||
(gnus-art-defun gnus-article-remove-leading-whitespace)
|
||||
(gnus-art-defun gnus-article-display-x-face)
|
||||
(gnus-art-defun gnus-article-display-face)
|
||||
(gnus-art-defun gnus-article-de-quoted-unreadable)
|
||||
(gnus-art-defun gnus-article-de-base64-unreadable)
|
||||
(gnus-art-defun gnus-article-decode-HZ)
|
||||
(gnus-art-defun gnus-article-wash-html)
|
||||
(gnus-art-defun gnus-article-unsplit-urls)
|
||||
(gnus-art-defun gnus-article-hide-list-identifiers)
|
||||
(gnus-art-defun gnus-article-strip-banner)
|
||||
(gnus-art-defun gnus-article-babel)
|
||||
(gnus-art-defun gnus-article-hide-pem)
|
||||
(gnus-art-defun gnus-article-hide-signature)
|
||||
(gnus-art-defun gnus-article-strip-headers-in-body)
|
||||
(gnus-art-defun gnus-article-remove-trailing-blank-lines)
|
||||
(gnus-art-defun gnus-article-strip-leading-blank-lines)
|
||||
(gnus-art-defun gnus-article-strip-multiple-blank-lines)
|
||||
(gnus-art-defun gnus-article-strip-leading-space)
|
||||
(gnus-art-defun gnus-article-strip-trailing-space)
|
||||
(gnus-art-defun gnus-article-strip-blank-lines)
|
||||
(gnus-art-defun gnus-article-strip-all-blank-lines)
|
||||
(gnus-art-defun gnus-article-date-local)
|
||||
(gnus-art-defun gnus-article-date-english)
|
||||
(gnus-art-defun gnus-article-date-iso8601)
|
||||
(gnus-art-defun gnus-article-date-original)
|
||||
(gnus-art-defun gnus-article-treat-date)
|
||||
(gnus-art-defun gnus-article-date-ut)
|
||||
(gnus-art-defun gnus-article-decode-mime-words)
|
||||
(gnus-art-defun gnus-article-decode-charset)
|
||||
(gnus-art-defun gnus-article-decode-encoded-words)
|
||||
(gnus-art-defun gnus-article-date-user)
|
||||
(gnus-art-defun gnus-article-date-lapsed)
|
||||
(gnus-art-defun gnus-article-date-combined-lapsed)
|
||||
(gnus-art-defun gnus-article-emphasize)
|
||||
(gnus-art-defun gnus-article-treat-dumbquotes)
|
||||
(gnus-art-defun gnus-article-treat-non-ascii)
|
||||
(gnus-art-defun gnus-article-normalize-headers)
|
||||
;;(gnus-art-defun gnus-article-show-all-headers article-show-all)
|
||||
(mapc
|
||||
(lambda (func)
|
||||
(let (afunc gfunc)
|
||||
(if (consp func)
|
||||
(setq afunc (car func)
|
||||
gfunc (cdr func))
|
||||
(setq afunc func
|
||||
gfunc (intern (format "gnus-%s" func))))
|
||||
(defalias gfunc
|
||||
(when (fboundp afunc)
|
||||
`(lambda (&optional interactive &rest args)
|
||||
,(documentation afunc t)
|
||||
(interactive (list t))
|
||||
(with-current-buffer gnus-article-buffer
|
||||
(if interactive
|
||||
(call-interactively ',afunc)
|
||||
(apply #',afunc args))))))))
|
||||
'(article-hide-headers
|
||||
article-verify-x-pgp-sig
|
||||
article-verify-cancel-lock
|
||||
article-hide-boring-headers
|
||||
article-treat-overstrike
|
||||
article-treat-ansi-sequences
|
||||
article-fill-long-lines
|
||||
article-capitalize-sentences
|
||||
article-remove-cr
|
||||
article-remove-leading-whitespace
|
||||
article-display-x-face
|
||||
article-display-face
|
||||
article-de-quoted-unreadable
|
||||
article-de-base64-unreadable
|
||||
article-decode-HZ
|
||||
article-wash-html
|
||||
article-unsplit-urls
|
||||
article-hide-list-identifiers
|
||||
article-strip-banner
|
||||
article-babel
|
||||
article-hide-pem
|
||||
article-hide-signature
|
||||
article-strip-headers-in-body
|
||||
article-remove-trailing-blank-lines
|
||||
article-strip-leading-blank-lines
|
||||
article-strip-multiple-blank-lines
|
||||
article-strip-leading-space
|
||||
article-strip-trailing-space
|
||||
article-strip-blank-lines
|
||||
article-strip-all-blank-lines
|
||||
article-date-local
|
||||
article-date-english
|
||||
article-date-iso8601
|
||||
article-date-original
|
||||
article-treat-date
|
||||
article-date-ut
|
||||
article-decode-mime-words
|
||||
article-decode-charset
|
||||
article-decode-encoded-words
|
||||
article-date-user
|
||||
article-date-lapsed
|
||||
article-date-combined-lapsed
|
||||
article-emphasize
|
||||
article-treat-dumbquotes
|
||||
article-treat-non-ascii
|
||||
article-normalize-headers
|
||||
;;(article-show-all . gnus-article-show-all-headers)
|
||||
)))
|
||||
|
||||
;;;
|
||||
;;; Gnus article mode
|
||||
|
|
@ -4865,19 +4869,18 @@ General format specifiers can also be used. See Info node
|
|||
(defvar gnus-mime-button-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map [mouse-2] 'gnus-article-push-button)
|
||||
(define-key map [down-mouse-3] 'gnus-mime-button-menu)
|
||||
(dolist (c gnus-mime-button-commands)
|
||||
(define-key map (cadr c) (car c)))
|
||||
|
||||
(easy-menu-define gnus-mime-button-menu map "MIME button menu."
|
||||
`("MIME Part"
|
||||
,@(mapcar (lambda (c)
|
||||
(vector (caddr c) (car c) :active t))
|
||||
gnus-mime-button-commands)))
|
||||
|
||||
(define-key map [down-mouse-3]
|
||||
(easy-menu-binding gnus-mime-button-menu))
|
||||
map))
|
||||
|
||||
(easy-menu-define
|
||||
gnus-mime-button-menu gnus-mime-button-map "MIME button menu."
|
||||
`("MIME Part"
|
||||
,@(mapcar (lambda (c)
|
||||
(vector (caddr c) (car c) :active t))
|
||||
gnus-mime-button-commands)))
|
||||
|
||||
(defvar gnus-url-button-commands
|
||||
'((gnus-article-copy-string "u" "Copy URL to kill ring")))
|
||||
|
||||
|
|
@ -4920,6 +4923,16 @@ General format specifiers can also be used. See Info node
|
|||
(setq mm-w3m-safe-url-regexp nil)))
|
||||
,@body))
|
||||
|
||||
(defun gnus-mime-button-menu (event prefix)
|
||||
"Construct a context-sensitive menu of MIME commands."
|
||||
(interactive "e\nP")
|
||||
(save-window-excursion
|
||||
(let ((pos (event-start event)))
|
||||
(select-window (posn-window pos))
|
||||
(goto-char (posn-point pos))
|
||||
(gnus-article-check-buffer)
|
||||
(popup-menu gnus-mime-button-menu nil prefix))))
|
||||
|
||||
(defun gnus-mime-view-all-parts (&optional handles)
|
||||
"View all the MIME parts."
|
||||
(interactive)
|
||||
|
|
@ -5042,12 +5055,10 @@ and `gnus-mime-delete-part', and not provided at run-time normally."
|
|||
nil nil)))
|
||||
(gnus-mime-save-part-and-strip file))
|
||||
|
||||
(defun gnus-mime-save-part-and-strip (&optional file event)
|
||||
(defun gnus-mime-save-part-and-strip (&optional file)
|
||||
"Save the MIME part under point then replace it with an external body.
|
||||
If FILE is given, use it for the external part."
|
||||
(interactive (list nil last-nonmenu-event))
|
||||
(save-excursion
|
||||
(mouse-set-point event)
|
||||
(interactive)
|
||||
(gnus-article-check-buffer)
|
||||
(when (gnus-group-read-only-p)
|
||||
(error "The current group does not support deleting of parts"))
|
||||
|
|
@ -5079,16 +5090,15 @@ The current article has a complicated MIME structure, giving up..."))
|
|||
(access-type . "LOCAL-FILE")
|
||||
(name . ,file)))))
|
||||
;; (set-buffer gnus-summary-buffer)
|
||||
(gnus-article-edit-part handles id)))))
|
||||
(gnus-article-edit-part handles id))))
|
||||
|
||||
;; A function like `gnus-summary-save-parts' (`X m', `<MIME> <Extract all
|
||||
;; parts...>') but with stripping would be nice.
|
||||
|
||||
(defun gnus-mime-delete-part (&optional event)
|
||||
(defun gnus-mime-delete-part ()
|
||||
"Delete the MIME part under point.
|
||||
Replace it with some information about the removed part."
|
||||
(interactive (list last-nonmenu-event))
|
||||
(mouse-set-point event)
|
||||
(interactive)
|
||||
(gnus-article-check-buffer)
|
||||
(when (gnus-group-read-only-p)
|
||||
(error "The current group does not support deleting of parts"))
|
||||
|
|
@ -5134,36 +5144,33 @@ Deleting parts may malfunction or destroy the article; continue? "))
|
|||
;; (set-buffer gnus-summary-buffer)
|
||||
(gnus-article-edit-part handles id))))
|
||||
|
||||
(defun gnus-mime-save-part (&optional event)
|
||||
(defun gnus-mime-save-part ()
|
||||
"Save the MIME part under point."
|
||||
(interactive (list last-nonmenu-event))
|
||||
(mouse-set-point event)
|
||||
(interactive)
|
||||
(gnus-article-check-buffer)
|
||||
(let ((data (get-text-property (point) 'gnus-data)))
|
||||
(when data
|
||||
(mm-save-part data))))
|
||||
|
||||
(defun gnus-mime-pipe-part (&optional cmd event)
|
||||
"Pipe the MIME part under point to a process."
|
||||
(interactive (list nil last-nonmenu-event))
|
||||
(mouse-set-point event)
|
||||
(defun gnus-mime-pipe-part (&optional cmd)
|
||||
"Pipe the MIME part under point to a process.
|
||||
Use CMD as the process."
|
||||
(interactive)
|
||||
(gnus-article-check-buffer)
|
||||
(let ((data (get-text-property (point) 'gnus-data)))
|
||||
(when data
|
||||
(mm-pipe-part data cmd))))
|
||||
|
||||
(defun gnus-mime-view-part (&optional event)
|
||||
(defun gnus-mime-view-part ()
|
||||
"Interactively choose a viewing method for the MIME part under point."
|
||||
(interactive (list last-nonmenu-event))
|
||||
(save-excursion
|
||||
(mouse-set-point event)
|
||||
(gnus-article-check-buffer)
|
||||
(let ((data (get-text-property (point) 'gnus-data)))
|
||||
(when data
|
||||
(setq gnus-article-mime-handles
|
||||
(mm-merge-handles
|
||||
gnus-article-mime-handles (setq data (copy-sequence data))))
|
||||
(mm-interactively-view-part data)))))
|
||||
(interactive)
|
||||
(gnus-article-check-buffer)
|
||||
(let ((data (get-text-property (point) 'gnus-data)))
|
||||
(when data
|
||||
(setq gnus-article-mime-handles
|
||||
(mm-merge-handles
|
||||
gnus-article-mime-handles (setq data (copy-sequence data))))
|
||||
(mm-interactively-view-part data))))
|
||||
|
||||
(defun gnus-mime-view-part-as-type-internal ()
|
||||
(gnus-article-check-buffer)
|
||||
|
|
@ -5180,13 +5187,11 @@ Deleting parts may malfunction or destroy the article; continue? "))
|
|||
'("text/plain" . 0))
|
||||
'("application/octet-stream" . 0))))
|
||||
|
||||
(defun gnus-mime-view-part-as-type (&optional mime-type pred event)
|
||||
(defun gnus-mime-view-part-as-type (&optional mime-type pred)
|
||||
"Choose a MIME media type, and view the part as such.
|
||||
If non-nil, PRED is a predicate to use during completion to limit the
|
||||
available media-types."
|
||||
(interactive (list nil nil last-nonmenu-event))
|
||||
(save-excursion
|
||||
(if event (mouse-set-point event))
|
||||
(interactive)
|
||||
(unless mime-type
|
||||
(setq mime-type
|
||||
(let ((default (gnus-mime-view-part-as-type-internal)))
|
||||
|
|
@ -5217,14 +5222,13 @@ available media-types."
|
|||
(mm-merge-handles gnus-article-mime-handles handle))
|
||||
(when (mm-handle-displayed-p handle)
|
||||
(mm-remove-part handle))
|
||||
(gnus-mm-display-part handle)))))
|
||||
(gnus-mm-display-part handle))))
|
||||
|
||||
(defun gnus-mime-copy-part (&optional handle arg event)
|
||||
(defun gnus-mime-copy-part (&optional handle arg)
|
||||
"Put the MIME part under point into a new buffer.
|
||||
If `auto-compression-mode' is enabled, compressed files like .gz and .bz2
|
||||
are decompressed."
|
||||
(interactive (list nil current-prefix-arg last-nonmenu-event))
|
||||
(mouse-set-point event)
|
||||
(interactive (list nil current-prefix-arg))
|
||||
(gnus-article-check-buffer)
|
||||
(unless handle
|
||||
(setq handle (get-text-property (point) 'gnus-data)))
|
||||
|
|
@ -5276,12 +5280,9 @@ are decompressed."
|
|||
(setq buffer-file-name nil))
|
||||
(goto-char (point-min)))))
|
||||
|
||||
(defun gnus-mime-print-part (&optional handle filename event)
|
||||
(defun gnus-mime-print-part (&optional handle filename)
|
||||
"Print the MIME part under point."
|
||||
(interactive
|
||||
(list nil (ps-print-preprint current-prefix-arg) last-nonmenu-event))
|
||||
(save-excursion
|
||||
(mouse-set-point event)
|
||||
(interactive (list nil (ps-print-preprint current-prefix-arg)))
|
||||
(gnus-article-check-buffer)
|
||||
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
|
||||
(contents (and handle (mm-get-part handle)))
|
||||
|
|
@ -5302,13 +5303,12 @@ are decompressed."
|
|||
(with-temp-buffer
|
||||
(insert contents)
|
||||
(gnus-print-buffer))
|
||||
(ps-despool filename))))))
|
||||
(ps-despool filename)))))
|
||||
|
||||
(defun gnus-mime-inline-part (&optional handle arg event)
|
||||
(defun gnus-mime-inline-part (&optional handle arg)
|
||||
"Insert the MIME part under point into the current buffer.
|
||||
Compressed files like .gz and .bz2 are decompressed."
|
||||
(interactive (list nil current-prefix-arg last-nonmenu-event))
|
||||
(if event (mouse-set-point event))
|
||||
(interactive (list nil current-prefix-arg))
|
||||
(gnus-article-check-buffer)
|
||||
(let* ((inhibit-read-only t)
|
||||
(b (point))
|
||||
|
|
@ -5402,12 +5402,10 @@ CHARSET may either be a string or a symbol."
|
|||
(setcdr param charset)
|
||||
(setcdr type (cons (cons 'charset charset) (cdr type)))))))
|
||||
|
||||
(defun gnus-mime-view-part-as-charset (&optional handle arg event)
|
||||
(defun gnus-mime-view-part-as-charset (&optional handle arg)
|
||||
"Insert the MIME part under point into the current buffer using the
|
||||
specified charset."
|
||||
(interactive (list nil current-prefix-arg last-nonmenu-event))
|
||||
(save-excursion
|
||||
(mouse-set-point event)
|
||||
(interactive (list nil current-prefix-arg))
|
||||
(gnus-article-check-buffer)
|
||||
(let ((handle (or handle (get-text-property (point) 'gnus-data)))
|
||||
(fun (get-text-property (point) 'gnus-callback))
|
||||
|
|
@ -5441,13 +5439,11 @@ specified charset."
|
|||
(setcar (cddr form)
|
||||
(list 'quote (or (cadr (member preferred parts))
|
||||
(car parts)))))
|
||||
(funcall fun handle))))))
|
||||
(funcall fun handle)))))
|
||||
|
||||
(defun gnus-mime-view-part-externally (&optional handle event)
|
||||
(defun gnus-mime-view-part-externally (&optional handle)
|
||||
"View the MIME part under point with an external viewer."
|
||||
(interactive (list nil last-nonmenu-event))
|
||||
(save-excursion
|
||||
(mouse-set-point event)
|
||||
(interactive)
|
||||
(gnus-article-check-buffer)
|
||||
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
|
||||
(mm-inlined-types nil)
|
||||
|
|
@ -5462,14 +5458,12 @@ specified charset."
|
|||
(gnus-mime-view-part-as-type
|
||||
nil (lambda (type) (stringp (mailcap-mime-info type))))
|
||||
(when handle
|
||||
(mm-display-part handle nil t))))))
|
||||
(mm-display-part handle nil t)))))
|
||||
|
||||
(defun gnus-mime-view-part-internally (&optional handle event)
|
||||
(defun gnus-mime-view-part-internally (&optional handle)
|
||||
"View the MIME part under point with an internal viewer.
|
||||
If no internal viewer is available, use an external viewer."
|
||||
(interactive (list nil last-nonmenu-event))
|
||||
(save-excursion
|
||||
(mouse-set-point event)
|
||||
(interactive)
|
||||
(gnus-article-check-buffer)
|
||||
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
|
||||
(mm-inlined-types '(".*"))
|
||||
|
|
@ -5483,7 +5477,7 @@ If no internal viewer is available, use an external viewer."
|
|||
(gnus-mime-view-part-as-type
|
||||
nil (lambda (type) (mm-inlinable-p handle type)))
|
||||
(when handle
|
||||
(gnus-bind-mm-vars (mm-display-part handle nil t)))))))
|
||||
(gnus-bind-mm-vars (mm-display-part handle nil t))))))
|
||||
|
||||
(defun gnus-mime-action-on-part (&optional action)
|
||||
"Do something with the MIME attachment at (point)."
|
||||
|
|
@ -5855,7 +5849,7 @@ all parts."
|
|||
(widget-convert-button
|
||||
'link b e
|
||||
:mime-handle handle
|
||||
:action #'gnus-widget-press-button
|
||||
:action 'gnus-widget-press-button
|
||||
:button-keymap gnus-mime-button-map
|
||||
:help-echo
|
||||
(lambda (widget)
|
||||
|
|
@ -6154,7 +6148,7 @@ If nil, don't show those extra buttons."
|
|||
article-type multipart
|
||||
rear-nonsticky t))
|
||||
(widget-convert-button 'link from (point)
|
||||
:action #'gnus-widget-press-button)
|
||||
:action 'gnus-widget-press-button)
|
||||
;; Do the handles
|
||||
(while (setq handle (pop handles))
|
||||
(add-text-properties
|
||||
|
|
@ -6178,7 +6172,7 @@ If nil, don't show those extra buttons."
|
|||
gnus-data ,handle
|
||||
rear-nonsticky t))
|
||||
(widget-convert-button 'link from (point)
|
||||
:action #'gnus-widget-press-button)
|
||||
:action 'gnus-widget-press-button)
|
||||
(insert " "))
|
||||
(insert "\n\n"))
|
||||
(when preferred
|
||||
|
|
@ -7121,11 +7115,13 @@ If given a prefix, show the hidden text instead."
|
|||
(when (and do-update-line
|
||||
(or (numberp article)
|
||||
(stringp article)))
|
||||
(with-current-buffer gnus-summary-buffer
|
||||
(let ((buf (current-buffer)))
|
||||
(set-buffer gnus-summary-buffer)
|
||||
(gnus-summary-update-article do-update-line sparse-header)
|
||||
(gnus-summary-goto-subject do-update-line nil t)
|
||||
(set-window-point (gnus-get-buffer-window (current-buffer) t)
|
||||
(point)))))))
|
||||
(point))
|
||||
(set-buffer buf))))))
|
||||
|
||||
(defun gnus-block-private-groups (group)
|
||||
"Allows images in newsgroups to be shown, blocks images in all
|
||||
|
|
@ -7320,7 +7316,8 @@ groups."
|
|||
(gnus-article-mode)
|
||||
(set-window-configuration winconf)
|
||||
;; Tippy-toe some to make sure that point remains where it was.
|
||||
(with-current-buffer curbuf
|
||||
(save-current-buffer
|
||||
(set-buffer curbuf)
|
||||
(set-window-start (get-buffer-window (current-buffer)) window-start)
|
||||
(goto-char p))))
|
||||
(gnus-summary-show-article)))
|
||||
|
|
@ -7872,16 +7869,15 @@ call it with the value of the `gnus-data' text property."
|
|||
(when fun
|
||||
(funcall fun data))))
|
||||
|
||||
(defun gnus-article-press-button (&optional event)
|
||||
(defun gnus-article-press-button ()
|
||||
"Check text at point for a callback function.
|
||||
If the text at point has a `gnus-callback' property,
|
||||
call it with the value of the `gnus-data' text property."
|
||||
(interactive (list last-nonmenu-event))
|
||||
(save-excursion
|
||||
(mouse-set-point event)
|
||||
(let ((fun (get-text-property (point) 'gnus-callback)))
|
||||
(when fun
|
||||
(funcall fun (get-text-property (point) 'gnus-data))))))
|
||||
(interactive)
|
||||
(let ((data (get-text-property (point) 'gnus-data))
|
||||
(fun (get-text-property (point) 'gnus-callback)))
|
||||
(when fun
|
||||
(funcall fun data))))
|
||||
|
||||
(defun gnus-article-highlight (&optional force)
|
||||
"Highlight current article.
|
||||
|
|
@ -8099,7 +8095,7 @@ url is put as the `gnus-button-url' overlay property on the button."
|
|||
(list 'mouse-face gnus-article-mouse-face))
|
||||
(list 'gnus-callback fun)
|
||||
(and data (list 'gnus-data data))))
|
||||
(widget-convert-button 'link from to :action #'gnus-widget-press-button
|
||||
(widget-convert-button 'link from to :action 'gnus-widget-press-button
|
||||
:help-echo (or text "Follow the link")
|
||||
:keymap gnus-url-button-map))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; gnus-cloud.el --- storing and retrieving data via IMAP -*- lexical-binding:t -*-
|
||||
;;; gnus-cloud.el --- storing and retrieving data via IMAP
|
||||
|
||||
;; Copyright (C) 2014-2019 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -52,12 +52,14 @@ Each element may be either a string or a property list.
|
|||
The latter should have a :directory element whose value is a string,
|
||||
and a :match element whose value is a regular expression to match
|
||||
against the basename of files in said directory."
|
||||
:group 'gnus-cloud
|
||||
:type '(repeat (choice (string :tag "File")
|
||||
(plist :tag "Property list"))))
|
||||
|
||||
(defcustom gnus-cloud-storage-method (if (featurep 'epg) 'epg 'base64-gzip)
|
||||
"Storage method for cloud data, defaults to EPG if that's available."
|
||||
:version "26.1"
|
||||
:group 'gnus-cloud
|
||||
:type '(radio (const :tag "No encoding" nil)
|
||||
(const :tag "Base64" base64)
|
||||
(const :tag "Base64+gzip" base64-gzip)
|
||||
|
|
@ -66,6 +68,7 @@ against the basename of files in said directory."
|
|||
(defcustom gnus-cloud-interactive t
|
||||
"Whether Gnus Cloud changes should be confirmed."
|
||||
:version "26.1"
|
||||
:group 'gnus-cloud
|
||||
:type 'boolean)
|
||||
|
||||
(defvar gnus-cloud-group-name "Emacs-Cloud")
|
||||
|
|
@ -78,6 +81,7 @@ against the basename of files in said directory."
|
|||
"The IMAP select method used to store the cloud data.
|
||||
See also `gnus-server-set-cloud-method-server' for an
|
||||
easy interactive way to set this from the Server buffer."
|
||||
:group 'gnus-cloud
|
||||
:type '(radio (const :tag "Not set" nil)
|
||||
(string :tag "A Gnus server name as a string")))
|
||||
|
||||
|
|
@ -127,7 +131,8 @@ easy interactive way to set this from the Server buffer."
|
|||
(base64-encode-region (point-min) (point-max)))
|
||||
|
||||
((eq gnus-cloud-storage-method 'epg)
|
||||
(let ((context (epg-make-context 'OpenPGP)))
|
||||
(let ((context (epg-make-context 'OpenPGP))
|
||||
cipher)
|
||||
(setf (epg-context-armor context) t)
|
||||
(setf (epg-context-textmode context) t)
|
||||
(let ((data (epg-encrypt-string context
|
||||
|
|
@ -348,7 +353,6 @@ Use old data if FORCE-OLDER is not nil."
|
|||
(group &optional previous method))
|
||||
|
||||
(defun gnus-cloud-ensure-cloud-group ()
|
||||
;; FIXME: `method' is not used!?
|
||||
(let ((method (if (stringp gnus-cloud-method)
|
||||
(gnus-server-to-method gnus-cloud-method)
|
||||
gnus-cloud-method)))
|
||||
|
|
|
|||
|
|
@ -644,14 +644,7 @@ articles in the topic and its subtopics."
|
|||
(add-text-properties
|
||||
(point)
|
||||
(prog1 (1+ (point))
|
||||
(eval gnus-topic-line-format-spec
|
||||
`((indentation . ,indentation)
|
||||
(visible . ,visible)
|
||||
(name . ,name)
|
||||
(level . ,level)
|
||||
(number-of-groups . ,number-of-groups)
|
||||
(total-number-of-articles . ,total-number-of-articles)
|
||||
(entries . ,entries))))
|
||||
(eval gnus-topic-line-format-spec))
|
||||
(list 'gnus-topic name
|
||||
'gnus-topic-level level
|
||||
'gnus-topic-unread unread
|
||||
|
|
|
|||
|
|
@ -38,7 +38,7 @@
|
|||
(require 'time-date)
|
||||
(require 'text-property-search)
|
||||
|
||||
(defcustom gnus-completing-read-function #'gnus-emacs-completing-read
|
||||
(defcustom gnus-completing-read-function 'gnus-emacs-completing-read
|
||||
"Function use to do completing read."
|
||||
:version "24.1"
|
||||
:group 'gnus-meta
|
||||
|
|
@ -87,7 +87,6 @@ This is a compatibility function for different Emacsen."
|
|||
|
||||
(defmacro gnus-eval-in-buffer-window (buffer &rest forms)
|
||||
"Pop to BUFFER, evaluate FORMS, and then return to the original window."
|
||||
(declare (indent 1) (debug (form body)))
|
||||
(let ((tempvar (make-symbol "GnusStartBufferWindow"))
|
||||
(w (make-symbol "w"))
|
||||
(buf (make-symbol "buf")))
|
||||
|
|
@ -104,6 +103,9 @@ This is a compatibility function for different Emacsen."
|
|||
,@forms)
|
||||
(select-window ,tempvar)))))
|
||||
|
||||
(put 'gnus-eval-in-buffer-window 'lisp-indent-function 1)
|
||||
(put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body))
|
||||
|
||||
(defsubst gnus-goto-char (point)
|
||||
(and point (goto-char point)))
|
||||
|
||||
|
|
@ -300,24 +302,26 @@ Symbols are also allowed; their print names are used instead."
|
|||
|
||||
(defmacro gnus-local-set-keys (&rest plist)
|
||||
"Set the keys in PLIST in the current keymap."
|
||||
(declare (indent 1))
|
||||
`(gnus-define-keys-1 (current-local-map) ',plist))
|
||||
|
||||
(defmacro gnus-define-keys (keymap &rest plist)
|
||||
"Define all keys in PLIST in KEYMAP."
|
||||
(declare (indent 1))
|
||||
`(gnus-define-keys-1 (quote ,keymap) (quote ,plist)))
|
||||
|
||||
(defmacro gnus-define-keys-safe (keymap &rest plist)
|
||||
"Define all keys in PLIST in KEYMAP without overwriting previous definitions."
|
||||
(declare (indent 1))
|
||||
`(gnus-define-keys-1 (quote ,keymap) (quote ,plist) t))
|
||||
|
||||
(put 'gnus-define-keys 'lisp-indent-function 1)
|
||||
(put 'gnus-define-keys-safe 'lisp-indent-function 1)
|
||||
(put 'gnus-local-set-keys 'lisp-indent-function 1)
|
||||
|
||||
(defmacro gnus-define-keymap (keymap &rest plist)
|
||||
"Define all keys in PLIST in KEYMAP."
|
||||
(declare (indent 1))
|
||||
`(gnus-define-keys-1 ,keymap (quote ,plist)))
|
||||
|
||||
(put 'gnus-define-keymap 'lisp-indent-function 1)
|
||||
|
||||
(defun gnus-define-keys-1 (keymap plist &optional safe)
|
||||
(when (null keymap)
|
||||
(error "Can't set keys in a null keymap"))
|
||||
|
|
@ -440,7 +444,7 @@ displayed in the echo area."
|
|||
`(let (str time)
|
||||
(cond ((eq gnus-add-timestamp-to-message 'log)
|
||||
(setq str (let (message-log-max)
|
||||
(apply #'message ,format-string ,args)))
|
||||
(apply 'message ,format-string ,args)))
|
||||
(when (and message-log-max
|
||||
(> message-log-max 0)
|
||||
(/= (length str) 0))
|
||||
|
|
@ -458,7 +462,7 @@ displayed in the echo area."
|
|||
(gnus-add-timestamp-to-message
|
||||
(if (or (and (null ,format-string) (null ,args))
|
||||
(progn
|
||||
(setq str (apply #'format ,format-string ,args))
|
||||
(setq str (apply 'format ,format-string ,args))
|
||||
(zerop (length str))))
|
||||
(prog1
|
||||
(and ,format-string str)
|
||||
|
|
@ -467,7 +471,7 @@ displayed in the echo area."
|
|||
(message "%s" (concat ,timestamp str))
|
||||
str))
|
||||
(t
|
||||
(apply #'message ,format-string ,args)))))))
|
||||
(apply 'message ,format-string ,args)))))))
|
||||
|
||||
(defvar gnus-action-message-log nil)
|
||||
|
||||
|
|
@ -486,10 +490,9 @@ that take a long time, 7 - not very important messages on stuff, 9 - messages
|
|||
inside loops."
|
||||
(if (<= level gnus-verbose)
|
||||
(let ((message
|
||||
(apply (if gnus-add-timestamp-to-message
|
||||
#'gnus-message-with-timestamp
|
||||
#'message)
|
||||
args)))
|
||||
(if gnus-add-timestamp-to-message
|
||||
(apply 'gnus-message-with-timestamp args)
|
||||
(apply 'message args))))
|
||||
(when (and (consp gnus-action-message-log)
|
||||
(<= level 3))
|
||||
(push message gnus-action-message-log))
|
||||
|
|
@ -497,7 +500,7 @@ inside loops."
|
|||
;; We have to do this format thingy here even if the result isn't
|
||||
;; shown - the return value has to be the same as the return value
|
||||
;; from `message'.
|
||||
(apply #'format args)))
|
||||
(apply 'format args)))
|
||||
|
||||
(defun gnus-final-warning ()
|
||||
(when (and (consp gnus-action-message-log)
|
||||
|
|
@ -510,7 +513,7 @@ inside loops."
|
|||
"Beep an error if LEVEL is equal to or less than `gnus-verbose'.
|
||||
ARGS are passed to `message'."
|
||||
(when (<= (floor level) gnus-verbose)
|
||||
(apply #'message args)
|
||||
(apply 'message args)
|
||||
(ding)
|
||||
(let (duration)
|
||||
(when (and (floatp level)
|
||||
|
|
@ -685,20 +688,18 @@ Lisp objects are loadable. Bind `print-quoted' and `print-readably'
|
|||
to t, and `print-escape-multibyte', `print-escape-newlines',
|
||||
`print-escape-nonascii', `print-length', `print-level' and
|
||||
`print-string-length' to nil."
|
||||
`(progn
|
||||
(defvar print-string-length) (defvar print-readably)
|
||||
(let ((print-quoted t)
|
||||
(print-readably t)
|
||||
;;print-circle
|
||||
;;print-continuous-numbering
|
||||
print-escape-multibyte
|
||||
print-escape-newlines
|
||||
print-escape-nonascii
|
||||
;;print-gensym
|
||||
print-length
|
||||
print-level
|
||||
print-string-length)
|
||||
,@forms)))
|
||||
`(let ((print-quoted t)
|
||||
(print-readably t)
|
||||
;;print-circle
|
||||
;;print-continuous-numbering
|
||||
print-escape-multibyte
|
||||
print-escape-newlines
|
||||
print-escape-nonascii
|
||||
;;print-gensym
|
||||
print-length
|
||||
print-level
|
||||
print-string-length)
|
||||
,@forms))
|
||||
|
||||
(defun gnus-prin1 (form)
|
||||
"Use `prin1' on FORM in the current buffer.
|
||||
|
|
@ -851,10 +852,11 @@ the user are disabled, it is recommended that only the most minimal
|
|||
operations are performed by FORMS. If you wish to assign many
|
||||
complicated values atomically, compute the results into temporary
|
||||
variables and then do only the assignment atomically."
|
||||
(declare (indent 0))
|
||||
`(let ((inhibit-quit gnus-atomic-be-safe))
|
||||
,@forms))
|
||||
|
||||
(put 'gnus-atomic-progn 'lisp-indent-function 0)
|
||||
|
||||
(defmacro gnus-atomic-progn-assign (protect &rest forms)
|
||||
"Evaluate FORMS, but ensure that the variables listed in PROTECT
|
||||
are not changed if anything in FORMS signals an error or otherwise
|
||||
|
|
@ -864,7 +866,6 @@ It is safe to use gnus-atomic-progn-assign with long computations.
|
|||
Note that if any of the symbols in PROTECT were unbound, they will be
|
||||
set to nil on a successful assignment. In case of an error or other
|
||||
non-local exit, it will still be unbound."
|
||||
(declare (indent 1)) ;;(debug (sexp body))
|
||||
(let* ((temp-sym-map (mapcar (lambda (x) (list (make-symbol
|
||||
(concat (symbol-name x)
|
||||
"-tmp"))
|
||||
|
|
@ -877,8 +878,8 @@ non-local exit, it will still be unbound."
|
|||
,(cadr x))))
|
||||
temp-sym-map))
|
||||
(sym-temp-let sym-temp-map)
|
||||
(temp-sym-assign (apply #'append temp-sym-map))
|
||||
(sym-temp-assign (apply #'append sym-temp-map))
|
||||
(temp-sym-assign (apply 'append temp-sym-map))
|
||||
(sym-temp-assign (apply 'append sym-temp-map))
|
||||
(result (make-symbol "result-tmp")))
|
||||
`(let (,@temp-sym-let
|
||||
,result)
|
||||
|
|
@ -889,6 +890,9 @@ non-local exit, it will still be unbound."
|
|||
(setq ,@sym-temp-assign))
|
||||
,result)))
|
||||
|
||||
(put 'gnus-atomic-progn-assign 'lisp-indent-function 1)
|
||||
;(put 'gnus-atomic-progn-assign 'edebug-form-spec '(sexp body))
|
||||
|
||||
(defmacro gnus-atomic-setq (&rest pairs)
|
||||
"Similar to setq, except that the real symbols are only assigned when
|
||||
there are no errors. And when the real symbols are assigned, they are
|
||||
|
|
@ -1098,16 +1102,16 @@ ARG is passed to the first function."
|
|||
(defun gnus-run-hooks (&rest funcs)
|
||||
"Does the same as `run-hooks', but saves the current buffer."
|
||||
(save-current-buffer
|
||||
(apply #'run-hooks funcs)))
|
||||
(apply 'run-hooks funcs)))
|
||||
|
||||
(defun gnus-run-hook-with-args (hook &rest args)
|
||||
"Does the same as `run-hook-with-args', but saves the current buffer."
|
||||
(save-current-buffer
|
||||
(apply #'run-hook-with-args hook args)))
|
||||
(apply 'run-hook-with-args hook args)))
|
||||
|
||||
(defun gnus-run-mode-hooks (&rest funcs)
|
||||
"Run `run-mode-hooks', saving the current buffer."
|
||||
(save-current-buffer (apply #'run-mode-hooks funcs)))
|
||||
(save-current-buffer (apply 'run-mode-hooks funcs)))
|
||||
|
||||
;;; Various
|
||||
|
||||
|
|
@ -1190,7 +1194,6 @@ ARG is passed to the first function."
|
|||
|
||||
;; Fixme: Why not use `with-output-to-temp-buffer'?
|
||||
(defmacro gnus-with-output-to-file (file &rest body)
|
||||
(declare (indent 1) (debug (form body)))
|
||||
(let ((buffer (make-symbol "output-buffer"))
|
||||
(size (make-symbol "output-buffer-size"))
|
||||
(leng (make-symbol "output-buffer-length"))
|
||||
|
|
@ -1213,6 +1216,9 @@ ARG is passed to the first function."
|
|||
(write-region (substring ,buffer 0 ,leng) nil ,file
|
||||
,append 'no-msg))))))
|
||||
|
||||
(put 'gnus-with-output-to-file 'lisp-indent-function 1)
|
||||
(put 'gnus-with-output-to-file 'edebug-form-spec '(form body))
|
||||
|
||||
(defun gnus-add-text-properties-when
|
||||
(property value start end properties &optional object)
|
||||
"Like `add-text-properties', only applied on where PROPERTY is VALUE."
|
||||
|
|
@ -1300,7 +1306,7 @@ sure of changing the value of `foo'."
|
|||
(setq gnus-info-buffer (current-buffer))
|
||||
(gnus-configure-windows 'info)))
|
||||
|
||||
(defun gnus-not-ignore (&rest _)
|
||||
(defun gnus-not-ignore (&rest args)
|
||||
t)
|
||||
|
||||
(defvar gnus-directory-sep-char-regexp "/"
|
||||
|
|
@ -1352,7 +1358,7 @@ SPEC is a predicate specifier that contains stuff like `or', `and',
|
|||
`(,spec elem))
|
||||
((listp spec)
|
||||
(if (memq (car spec) '(or and not))
|
||||
`(,(car spec) ,@(mapcar #'gnus-make-predicate-1 (cdr spec)))
|
||||
`(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec)))
|
||||
(error "Invalid predicate specifier: %s" spec)))))
|
||||
|
||||
(defun gnus-completing-read (prompt collection &optional require-match
|
||||
|
|
@ -1391,8 +1397,6 @@ SPEC is a predicate specifier that contains stuff like `or', `and',
|
|||
;; Make sure iswitchb is loaded before we let-bind its variables.
|
||||
;; If it is loaded inside the let, variables can become unbound afterwards.
|
||||
(require 'iswitchb)
|
||||
(declare-function iswitchb-minibuffer-setup "iswitchb" ())
|
||||
(defvar iswitchb-make-buflist-hook)
|
||||
(let ((iswitchb-make-buflist-hook
|
||||
(lambda ()
|
||||
(setq iswitchb-temp-buflist
|
||||
|
|
@ -1406,14 +1410,16 @@ SPEC is a predicate specifier that contains stuff like `or', `and',
|
|||
(unwind-protect
|
||||
(progn
|
||||
(or iswitchb-mode
|
||||
(add-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup))
|
||||
(add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))
|
||||
(iswitchb-read-buffer prompt def require-match))
|
||||
(or iswitchb-mode
|
||||
(remove-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup)))))
|
||||
(remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)))))
|
||||
|
||||
(put 'gnus-parse-without-error 'lisp-indent-function 0)
|
||||
(put 'gnus-parse-without-error 'edebug-form-spec '(body))
|
||||
|
||||
(defmacro gnus-parse-without-error (&rest body)
|
||||
"Allow continuing onto the next line even if an error occurs."
|
||||
(declare (indent 0) (debug (body)))
|
||||
`(while (not (eobp))
|
||||
(condition-case ()
|
||||
(progn
|
||||
|
|
@ -1504,17 +1510,18 @@ Return nil otherwise."
|
|||
|
||||
(defvar tool-bar-mode)
|
||||
|
||||
(defun gnus-tool-bar-update (&rest _)
|
||||
(defun gnus-tool-bar-update (&rest ignore)
|
||||
"Update the tool bar."
|
||||
(when (bound-and-true-p tool-bar-mode)
|
||||
(when (and (boundp 'tool-bar-mode)
|
||||
tool-bar-mode)
|
||||
(let* ((args nil)
|
||||
(func (cond ((fboundp 'tool-bar-update)
|
||||
#'tool-bar-update)
|
||||
'tool-bar-update)
|
||||
((fboundp 'force-window-update)
|
||||
#'force-window-update)
|
||||
'force-window-update)
|
||||
((fboundp 'redraw-frame)
|
||||
(setq args (list (selected-frame)))
|
||||
#'redraw-frame)
|
||||
'redraw-frame)
|
||||
(t 'ignore))))
|
||||
(apply func args))))
|
||||
|
||||
|
|
@ -1529,7 +1536,7 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp
|
|||
(if seqs2_n
|
||||
(let* ((seqs (cons seq1 seqs2_n))
|
||||
(cnt 0)
|
||||
(heads (mapcar (lambda (_seq)
|
||||
(heads (mapcar (lambda (seq)
|
||||
(make-symbol (concat "head"
|
||||
(int-to-string
|
||||
(setq cnt (1+ cnt))))))
|
||||
|
|
@ -1562,7 +1569,8 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp
|
|||
system-configuration)
|
||||
((memq 'type lst)
|
||||
(symbol-name system-type))
|
||||
(t nil))))
|
||||
(t nil)))
|
||||
codename)
|
||||
(cond
|
||||
((not (memq 'emacs lst))
|
||||
nil)
|
||||
|
|
@ -1578,7 +1586,9 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp
|
|||
empty directories from OLD-PATH."
|
||||
(when (file-exists-p old-path)
|
||||
(let* ((old-dir (file-name-directory old-path))
|
||||
(old-name (file-name-nondirectory old-path))
|
||||
(new-dir (file-name-directory new-path))
|
||||
(new-name (file-name-nondirectory new-path))
|
||||
temp)
|
||||
(gnus-make-directory new-dir)
|
||||
(rename-file old-path new-path t)
|
||||
|
|
@ -1683,7 +1693,7 @@ lists of strings."
|
|||
(setq props (plist-put props :foreground (face-foreground face)))
|
||||
(setq props (plist-put props :background (face-background face))))
|
||||
(ignore-errors
|
||||
(apply #'create-image file type data-p props))))
|
||||
(apply 'create-image file type data-p props))))
|
||||
|
||||
(defun gnus-put-image (glyph &optional string category)
|
||||
(let ((point (point)))
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; nnimap.el --- IMAP interface for Gnus -*- lexical-binding:t -*-
|
||||
;;; nnimap.el --- IMAP interface for Gnus
|
||||
|
||||
;; Copyright (C) 2010-2019 Free Software Foundation, Inc.
|
||||
|
||||
|
|
|
|||
|
|
@ -597,7 +597,7 @@ FILE is the file where FUNCTION was probably defined."
|
|||
;; of the *packages* in which the function is defined.
|
||||
(let* ((name (symbol-name symbol))
|
||||
(re (concat "\\_<" (regexp-quote name) "\\_>"))
|
||||
(news (directory-files data-directory t "\\`NEWS"))
|
||||
(news (directory-files data-directory t "\\`NEWS.[1-9]"))
|
||||
(place nil)
|
||||
(first nil))
|
||||
(with-temp-buffer
|
||||
|
|
@ -612,7 +612,7 @@ FILE is the file where FUNCTION was probably defined."
|
|||
;; Almost all entries are of the form "* ... in Emacs NN.MM."
|
||||
;; but there are also a few in the form "* Emacs NN.MM is a bug
|
||||
;; fix release ...".
|
||||
(if (not (re-search-backward "^\\* .* Emacs \\([0-9.]+[0-9]\\)"
|
||||
(if (not (re-search-backward "^\\*.* Emacs \\([0-9.]+[0-9]\\)"
|
||||
nil t))
|
||||
(message "Ref found in non-versioned section in %S"
|
||||
(file-name-nondirectory f))
|
||||
|
|
@ -621,7 +621,8 @@ FILE is the file where FUNCTION was probably defined."
|
|||
(setq place (list f pos))
|
||||
(setq first version)))))))))
|
||||
(when first
|
||||
(make-text-button first nil 'type 'help-news 'help-args place))))
|
||||
(make-text-button first nil 'type 'help-news 'help-args place))
|
||||
first))
|
||||
|
||||
(add-hook 'help-fns-describe-function-functions
|
||||
#'help-fns--mention-first-release)
|
||||
|
|
|
|||
|
|
@ -1537,7 +1537,7 @@ Return the input string."
|
|||
(quail-terminate-translation))
|
||||
|
||||
(defun quail-update-translation (control-flag)
|
||||
"Update the current translation status according to CONTROL-FLAG.
|
||||
"Update the current translation status according to CONTROL-FLAG.
|
||||
If CONTROL-FLAG is integer value, it is the number of keys in the
|
||||
head `quail-current-key' which can be translated. The remaining keys
|
||||
are put back to `unread-command-events' to be handled again. If
|
||||
|
|
|
|||
|
|
@ -109,7 +109,7 @@ folder. This is useful for folders that are easily regenerated."
|
|||
(let ((folder mh-current-folder)
|
||||
(window-config mh-previous-window-config))
|
||||
(mh-set-folder-modified-p t) ; lock folder to kill it
|
||||
(mh-exec-cmd-daemon "rmf" #'mh-rmf-daemon folder)
|
||||
(mh-exec-cmd-daemon "rmf" 'mh-rmf-daemon folder)
|
||||
(when (boundp 'mh-speed-folder-map)
|
||||
(mh-speed-invalidate-map folder))
|
||||
(mh-remove-from-sub-folders-cache folder)
|
||||
|
|
@ -123,7 +123,7 @@ folder. This is useful for folders that are easily regenerated."
|
|||
(message "Folder %s removed" folder))
|
||||
(message "Folder not removed")))
|
||||
|
||||
(defun mh-rmf-daemon (_process output)
|
||||
(defun mh-rmf-daemon (process output)
|
||||
"The rmf PROCESS puts OUTPUT in temporary buffer.
|
||||
Display the results only if something went wrong."
|
||||
(set-buffer (get-buffer-create mh-temp-buffer))
|
||||
|
|
|
|||
|
|
@ -1225,45 +1225,6 @@ scroll the window of possible completions."
|
|||
(if (eq (car bounds) base) md-at-point
|
||||
(completion-metadata (substring string 0 base) table pred))))
|
||||
|
||||
(defun completion-score-sort (completions)
|
||||
(sort completions
|
||||
(lambda (x y)
|
||||
(> (or (get-text-property 0 'completion-score x) 0)
|
||||
(or (get-text-property 0 'completion-score y) 0)))))
|
||||
|
||||
(defun completion-sort (all &optional prefer-regular table-sort-fun)
|
||||
"Sort ALL, which is the list of all the completion strings we found.
|
||||
If PREFER-REGULAR, then give a bit more importance to returning
|
||||
an ordering that is easy to scan quickly (e.g. lexicographic) rather
|
||||
then trying to minimize the expected position of the completion
|
||||
actually desired.
|
||||
TABLE-SORT-FUN is the sorting function specified by the completion table,
|
||||
if applicable.
|
||||
The sort is performed in a destructive way."
|
||||
(cond
|
||||
(table-sort-fun
|
||||
;; I feel like we should slowly deprecate table-sort-fun (probably
|
||||
;; replacing it with a way for the completion table to provide scores),
|
||||
;; so let's not try to be clever here.
|
||||
(funcall table-sort-fun all))
|
||||
(t
|
||||
;; Prefer shorter completions, by default.
|
||||
(if prefer-regular
|
||||
(setq all (sort all #'string-lessp))
|
||||
(setq all (sort all (lambda (c1 c2) (< (length c1) (length c2)))))
|
||||
(if (minibufferp)
|
||||
;; Prefer recently used completions and put the default, if
|
||||
;; it exists, on top.
|
||||
(let ((hist (symbol-value minibuffer-history-variable)))
|
||||
(setq all (sort all
|
||||
(lambda (c1 c2)
|
||||
(cond ((equal c1 minibuffer-default) t)
|
||||
((equal c2 minibuffer-default) nil)
|
||||
(t (> (length (member c1 hist))
|
||||
(length (member c2 hist)))))))))))
|
||||
(setq all (completion-score-sort all))
|
||||
all)))
|
||||
|
||||
(defun completion-all-sorted-completions (&optional start end)
|
||||
(or completion-all-sorted-completions
|
||||
(let* ((start (or start (minibuffer-prompt-end)))
|
||||
|
|
@ -1293,7 +1254,23 @@ The sort is performed in a destructive way."
|
|||
(setq all (delete-dups all))
|
||||
(setq last (last all))
|
||||
|
||||
(setq all (completion-sort all nil sort-fun))
|
||||
(cond
|
||||
(sort-fun
|
||||
(setq all (funcall sort-fun all)))
|
||||
(t
|
||||
;; Prefer shorter completions, by default.
|
||||
(setq all (sort all (lambda (c1 c2) (< (length c1) (length c2)))))
|
||||
(if (minibufferp)
|
||||
;; Prefer recently used completions and put the default, if
|
||||
;; it exists, on top.
|
||||
(let ((hist (symbol-value minibuffer-history-variable)))
|
||||
(setq all
|
||||
(sort all
|
||||
(lambda (c1 c2)
|
||||
(cond ((equal c1 minibuffer-default) t)
|
||||
((equal c2 minibuffer-default) nil)
|
||||
(t (> (length (member c1 hist))
|
||||
(length (member c2 hist))))))))))))
|
||||
;; Cache the result. This is not just for speed, but also so that
|
||||
;; repeated calls to minibuffer-force-complete can cycle through
|
||||
;; all possibilities.
|
||||
|
|
@ -1910,7 +1887,9 @@ variables.")
|
|||
;; not always.
|
||||
(let ((sort-fun (completion-metadata-get
|
||||
all-md 'display-sort-function)))
|
||||
(completion-sort completions 'prefer-regular sort-fun)))
|
||||
(if sort-fun
|
||||
(funcall sort-fun completions)
|
||||
(sort completions 'string-lessp))))
|
||||
(when afun
|
||||
(setq completions
|
||||
(mapcar (lambda (s)
|
||||
|
|
@ -2891,9 +2870,7 @@ Return the new suffix."
|
|||
'point
|
||||
(substring afterpoint 0 (cdr bounds)))))
|
||||
(all (completion-pcm--all-completions prefix pattern table pred)))
|
||||
(when all
|
||||
(nconc (completion-pcm--hilit-commonality pattern all)
|
||||
(car bounds)))))
|
||||
(completion-hilit-commonality all point (car bounds))))
|
||||
|
||||
;;; Partial-completion-mode style completion.
|
||||
|
||||
|
|
@ -3056,8 +3033,8 @@ PATTERN is as returned by `completion-pcm--string->pattern'."
|
|||
(when (string-match-p regex c) (push c poss)))
|
||||
(nreverse poss))))))
|
||||
|
||||
(defvar completion-score-match-tightness 100
|
||||
"Controls how the completion style scores its matches.
|
||||
(defvar flex-score-match-tightness 100
|
||||
"Controls how the `flex' completion style scores its matches.
|
||||
|
||||
Value is a positive number. Values smaller than one make the
|
||||
scoring formula value matches scattered along the string, while
|
||||
|
|
@ -3102,7 +3079,7 @@ latter (which has two).")
|
|||
;; For the numerator, we use the number of +, i.e. the
|
||||
;; length of the pattern. For the denominator, it
|
||||
;; sums (1+ (/ (grouplen - 1)
|
||||
;; completion-score-match-tightness)) across all groups of
|
||||
;; flex-score-match-tightness)) across all groups of
|
||||
;; -, sums one to that total, and then multiples by
|
||||
;; the length of the string.
|
||||
(score-numerator 0)
|
||||
|
|
@ -3118,7 +3095,7 @@ latter (which has two).")
|
|||
score-denominator (+ score-denominator
|
||||
1
|
||||
(/ (- a last-b 1)
|
||||
completion-score-match-tightness
|
||||
flex-score-match-tightness
|
||||
1.0))))
|
||||
(setq
|
||||
last-b b))))
|
||||
|
|
|
|||
109
lisp/net/ldap.el
109
lisp/net/ldap.el
|
|
@ -1,4 +1,4 @@
|
|||
;;; ldap.el --- client interface to LDAP for Emacs -*- lexical-binding:t -*-
|
||||
;;; ldap.el --- client interface to LDAP for Emacs
|
||||
|
||||
;; Copyright (C) 1998-2019 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -419,12 +419,12 @@ RFC2798 Section 9.1.1")
|
|||
(encode-coding-string str ldap-coding-system))
|
||||
|
||||
(defun ldap-decode-address (str)
|
||||
(mapconcat #'ldap-decode-string
|
||||
(mapconcat 'ldap-decode-string
|
||||
(split-string str "\\$")
|
||||
"\n"))
|
||||
|
||||
(defun ldap-encode-address (str)
|
||||
(mapconcat #'ldap-encode-string
|
||||
(mapconcat 'ldap-encode-string
|
||||
(split-string str "\n")
|
||||
"$"))
|
||||
|
||||
|
|
@ -566,9 +566,9 @@ its distinguished name DN.
|
|||
The function returns a list of matching entries. Each entry is itself
|
||||
an alist of attribute/value pairs."
|
||||
(let* ((buf (get-buffer-create " *ldap-search*"))
|
||||
(bufval (get-buffer-create " *ldap-value*"))
|
||||
(host (or (plist-get search-plist 'host)
|
||||
ldap-default-host))
|
||||
(bufval (get-buffer-create " *ldap-value*"))
|
||||
(host (or (plist-get search-plist 'host)
|
||||
ldap-default-host))
|
||||
;; find entries with port "ldap" that match the requested host if any
|
||||
(asfound (when (plist-get search-plist 'auth-source)
|
||||
(nth 0 (auth-source-search :host (or host t)
|
||||
|
|
@ -592,60 +592,59 @@ an alist of attribute/value pairs."
|
|||
(base (or (plist-get search-plist 'base)
|
||||
(plist-get asfound :base)
|
||||
ldap-default-base))
|
||||
(filter (plist-get search-plist 'filter))
|
||||
(attributes (plist-get search-plist 'attributes))
|
||||
(attrsonly (plist-get search-plist 'attrsonly))
|
||||
(scope (plist-get search-plist 'scope))
|
||||
(auth (plist-get search-plist 'auth))
|
||||
(deref (plist-get search-plist 'deref))
|
||||
(timelimit (plist-get search-plist 'timelimit))
|
||||
(sizelimit (plist-get search-plist 'sizelimit))
|
||||
(withdn (plist-get search-plist 'withdn))
|
||||
(numres 0)
|
||||
(arglist
|
||||
(append
|
||||
(if (and host
|
||||
(not (equal "" host)))
|
||||
(list (format
|
||||
;; Use -H if host is a new-style LDAP URI.
|
||||
(if (string-match "\\`[a-zA-Z]+://" host)
|
||||
"-H%s"
|
||||
"-h%s")
|
||||
host)))
|
||||
(if (and attrsonly
|
||||
(not (equal "" attrsonly)))
|
||||
(list "-A"))
|
||||
(if (and base
|
||||
(not (equal "" base)))
|
||||
(list (format "-b%s" base)))
|
||||
(if (and scope
|
||||
(not (equal "" scope)))
|
||||
(list (format "-s%s" scope)))
|
||||
(if (and binddn
|
||||
(not (equal "" binddn)))
|
||||
(list (format "-D%s" binddn)))
|
||||
(if (and auth
|
||||
(equal 'simple auth))
|
||||
(list "-x"))
|
||||
;; Allow passwd to be set to "", representing a blank password.
|
||||
(if passwd
|
||||
(list "-W"))
|
||||
(if (and deref
|
||||
(not (equal "" deref)))
|
||||
(list (format "-a%s" deref)))
|
||||
(if (and timelimit
|
||||
(not (equal "" timelimit)))
|
||||
(list (format "-l%s" timelimit)))
|
||||
(if (and sizelimit
|
||||
(not (equal "" sizelimit)))
|
||||
(list (format "-z%s" sizelimit)))))
|
||||
dn name value record result)
|
||||
(filter (plist-get search-plist 'filter))
|
||||
(attributes (plist-get search-plist 'attributes))
|
||||
(attrsonly (plist-get search-plist 'attrsonly))
|
||||
(scope (plist-get search-plist 'scope))
|
||||
(auth (plist-get search-plist 'auth))
|
||||
(deref (plist-get search-plist 'deref))
|
||||
(timelimit (plist-get search-plist 'timelimit))
|
||||
(sizelimit (plist-get search-plist 'sizelimit))
|
||||
(withdn (plist-get search-plist 'withdn))
|
||||
(numres 0)
|
||||
arglist dn name value record result proc)
|
||||
(if (or (null filter)
|
||||
(equal "" filter))
|
||||
(error "No search filter"))
|
||||
(setq filter (cons filter attributes))
|
||||
(with-current-buffer buf
|
||||
(erase-buffer)
|
||||
(if (and host
|
||||
(not (equal "" host)))
|
||||
(setq arglist (nconc arglist
|
||||
(list (format
|
||||
;; Use -H if host is a new-style LDAP URI.
|
||||
(if (string-match "^[a-zA-Z]+://" host)
|
||||
"-H%s"
|
||||
"-h%s")
|
||||
host)))))
|
||||
(if (and attrsonly
|
||||
(not (equal "" attrsonly)))
|
||||
(setq arglist (nconc arglist (list "-A"))))
|
||||
(if (and base
|
||||
(not (equal "" base)))
|
||||
(setq arglist (nconc arglist (list (format "-b%s" base)))))
|
||||
(if (and scope
|
||||
(not (equal "" scope)))
|
||||
(setq arglist (nconc arglist (list (format "-s%s" scope)))))
|
||||
(if (and binddn
|
||||
(not (equal "" binddn)))
|
||||
(setq arglist (nconc arglist (list (format "-D%s" binddn)))))
|
||||
(if (and auth
|
||||
(equal 'simple auth))
|
||||
(setq arglist (nconc arglist (list "-x"))))
|
||||
;; Allow passwd to be set to "", representing a blank password.
|
||||
(if passwd
|
||||
(setq arglist (nconc arglist (list "-W"))))
|
||||
(if (and deref
|
||||
(not (equal "" deref)))
|
||||
(setq arglist (nconc arglist (list (format "-a%s" deref)))))
|
||||
(if (and timelimit
|
||||
(not (equal "" timelimit)))
|
||||
(setq arglist (nconc arglist (list (format "-l%s" timelimit)))))
|
||||
(if (and sizelimit
|
||||
(not (equal "" sizelimit)))
|
||||
(setq arglist (nconc arglist (list (format "-z%s" sizelimit)))))
|
||||
(if passwd
|
||||
;; Leave process-connection-type at its default value. See
|
||||
;; discussion in Bug#33050.
|
||||
|
|
@ -673,7 +672,7 @@ an alist of attribute/value pairs."
|
|||
" bind distinguished name (binddn)"))
|
||||
(error "Failed ldapsearch invocation: %s \"%s\""
|
||||
ldap-ldapsearch-prog
|
||||
(mapconcat #'identity proc-args "\" \""))))))
|
||||
(mapconcat 'identity proc-args "\" \""))))))
|
||||
(apply #'call-process ldap-ldapsearch-prog
|
||||
;; Ignore stderr, which can corrupt results
|
||||
nil (list buf nil) nil
|
||||
|
|
|
|||
|
|
@ -1871,11 +1871,11 @@ This function does not alter the INPUT string."
|
|||
(setq global-mode-string
|
||||
(append global-mode-string '(rcirc-activity-string))))
|
||||
(add-hook 'window-configuration-change-hook
|
||||
#'rcirc-window-configuration-change))
|
||||
'rcirc-window-configuration-change))
|
||||
(setq global-mode-string
|
||||
(delete 'rcirc-activity-string global-mode-string))
|
||||
(remove-hook 'window-configuration-change-hook
|
||||
#'rcirc-window-configuration-change)))
|
||||
'rcirc-window-configuration-change)))
|
||||
|
||||
(or (assq 'rcirc-ignore-buffer-activity-flag minor-mode-alist)
|
||||
(setq minor-mode-alist
|
||||
|
|
|
|||
|
|
@ -334,92 +334,6 @@ terminated by the end of line (i.e., `comment-end' is empty)."
|
|||
(const :tag "EOL-terminated" eol))
|
||||
:group 'comment)
|
||||
|
||||
;;;; Setup syntax from "high-level" description of comment syntax
|
||||
|
||||
;; This defines `comment-set-syntax' so a major mode can just call
|
||||
;; this one function to setup the comment syntax both in the syntax-table
|
||||
;; and in the various comment-* variables.
|
||||
|
||||
(defvar comment--set-table
|
||||
;; We want to associate extra properties with syntax-table, but syntax-tables
|
||||
;; don't have "properties", so we use an eq-hash-table indexed by
|
||||
;; syntax-tables instead.
|
||||
(make-hash-table :test #'eq))
|
||||
|
||||
(defun comment--set-comment-syntax (st comment-list)
|
||||
"Set up comment functionality for generic mode."
|
||||
(let ((chars nil)
|
||||
(comstyles)
|
||||
(comment-start nil))
|
||||
|
||||
;; Go through all the comments.
|
||||
(pcase-dolist (`(,start ,end . ,props) comment-list)
|
||||
(let ((nested (if (plist-get props :nested) "n"))
|
||||
(comstyle
|
||||
;; Reuse comstyles if necessary.
|
||||
(or (cdr (assoc start comstyles))
|
||||
(cdr (assoc end comstyles))
|
||||
;; Otherwise, use a style not yet in use.
|
||||
(if (not (rassoc "" comstyles)) "")
|
||||
(if (not (rassoc "b" comstyles)) "b")
|
||||
"c")))
|
||||
(push (cons start comstyle) comstyles)
|
||||
(push (cons end comstyle) comstyles)
|
||||
|
||||
;; Setup the syntax table.
|
||||
(if (= (length start) 1)
|
||||
(modify-syntax-entry (aref start 0)
|
||||
(concat "< " comstyle nested) st)
|
||||
(let ((c0 (aref start 0)) (c1 (aref start 1)))
|
||||
;; Store the relevant info but don't update yet.
|
||||
(push (cons c0 (concat (cdr (assoc c0 chars)) "1")) chars)
|
||||
(push (cons c1 (concat (cdr (assoc c1 chars))
|
||||
(concat "2" comstyle)))
|
||||
chars)))
|
||||
(if (= (length end) 1)
|
||||
(modify-syntax-entry (aref end 0)
|
||||
(concat "> " comstyle nested) st)
|
||||
(let ((c0 (aref end 0)) (c1 (aref end 1)))
|
||||
;; Store the relevant info but don't update yet.
|
||||
(push (cons c0 (concat (cdr (assoc c0 chars))
|
||||
(concat "3" comstyle)))
|
||||
chars)
|
||||
(push (cons c1 (concat (cdr (assoc c1 chars)) "4")) chars)))))
|
||||
|
||||
;; Process the chars that were part of a 2-char comment marker
|
||||
(with-syntax-table st ;For `char-syntax'.
|
||||
(dolist (cs (nreverse chars))
|
||||
(modify-syntax-entry (car cs)
|
||||
(concat (char-to-string (char-syntax (car cs)))
|
||||
" " (cdr cs))
|
||||
st)))))
|
||||
|
||||
(defun comment--set-comment-vars (comment-list)
|
||||
(when comment-list
|
||||
(let ((first (car comment-list)))
|
||||
(setq-local comment-start (car first))
|
||||
(setq-local comment-end
|
||||
(let ((end (cadr first)))
|
||||
(if (string-equal end "\n") "" end))))
|
||||
(unless comment-start-skip ;Don't override manual setup.
|
||||
(setq-local comment-start-skip
|
||||
(concat (regexp-opt (mapcar #'car comment-list))
|
||||
"+[ \t]*")))
|
||||
(unless comment-end-skip ;Don't override manual setup.
|
||||
(setq-local comment-end-skip
|
||||
(concat "[ \t]*"
|
||||
(regexp-opt (mapcar #'cadr comment-list)))))))
|
||||
|
||||
(defun comment-set-syntax (st comment-list)
|
||||
(comment--set-comment-syntax st comment-list)
|
||||
(setf (gethash st comment--set-table) comment-list))
|
||||
|
||||
(defun comment-get-syntax (&optional st)
|
||||
(unless st (setq st (syntax-table)))
|
||||
(or (gethash st comment--set-table)
|
||||
(let ((parent (char-table-parent st)))
|
||||
(when parent (comment-get-syntax parent)))))
|
||||
|
||||
;;;;
|
||||
;;;; Helpers
|
||||
;;;;
|
||||
|
|
@ -444,14 +358,11 @@ functions work correctly. Lisp callers of any other `comment-*'
|
|||
function should first call this function explicitly."
|
||||
(unless (and (not comment-start) noerror)
|
||||
(unless comment-start
|
||||
(let ((comment-list (comment-get-syntax)))
|
||||
(if comment-list
|
||||
(comment--set-comment-vars comment-list)
|
||||
(let ((cs (read-string "No comment syntax is defined. Use: ")))
|
||||
(if (zerop (length cs))
|
||||
(error "No comment syntax defined")
|
||||
(set (make-local-variable 'comment-start) cs)
|
||||
(set (make-local-variable 'comment-start-skip) cs))))))
|
||||
(let ((cs (read-string "No comment syntax is defined. Use: ")))
|
||||
(if (zerop (length cs))
|
||||
(error "No comment syntax defined")
|
||||
(set (make-local-variable 'comment-start) cs)
|
||||
(set (make-local-variable 'comment-start-skip) cs))))
|
||||
;; comment-use-syntax
|
||||
(when (eq comment-use-syntax 'undecided)
|
||||
(set (make-local-variable 'comment-use-syntax)
|
||||
|
|
|
|||
|
|
@ -83,11 +83,10 @@ Signal an error if URI is not a valid file URL."
|
|||
(cond ((not scheme)
|
||||
(unless pattern
|
||||
(rng-uri-error "URI `%s' does not have a scheme" uri)))
|
||||
((not (member (downcase scheme) '("file" "http")))
|
||||
(rng-uri-error "URI `%s' does not use the `file:' or `http:' scheme" uri)))
|
||||
(when (and (equal (downcase scheme) "file")
|
||||
(not (member authority
|
||||
(cons (system-name) '(nil "" "localhost")))))
|
||||
((not (string= (downcase scheme) "file"))
|
||||
(rng-uri-error "URI `%s' does not use the `file:' scheme" uri)))
|
||||
(when (not (member authority
|
||||
(cons (system-name) '(nil "" "localhost"))))
|
||||
(rng-uri-error "URI `%s' does not start with `file:///' or `file://localhost/'"
|
||||
uri))
|
||||
(when query
|
||||
|
|
|
|||
|
|
@ -439,8 +439,7 @@ and VALUE-END, otherwise a STRING giving the value."
|
|||
(comment
|
||||
(xmltok+ (xmltok-g markup-declaration "!")
|
||||
(xmltok-g comment-first-dash "-"
|
||||
(xmltok-g comment-open "-") opt)
|
||||
opt))
|
||||
(xmltok-g comment-open "-") opt) opt))
|
||||
(cdata-section
|
||||
(xmltok+ "!"
|
||||
(xmltok-g marked-section-open "\\[")
|
||||
|
|
@ -541,9 +540,7 @@ and VALUE-END, otherwise a STRING giving the value."
|
|||
"%" (xmltok-g param-entity-ref
|
||||
ncname
|
||||
(xmltok-g param-entity-ref-close
|
||||
";")
|
||||
opt)
|
||||
opt))
|
||||
";") opt) opt))
|
||||
(starts-with-nmtoken-not-name
|
||||
(xmltok-g nmtoken
|
||||
(xmltok-p name-continue-not-start-char or ":")
|
||||
|
|
@ -574,8 +571,7 @@ and VALUE-END, otherwise a STRING giving the value."
|
|||
"!" (xmltok-p (xmltok-g comment-first-dash "-"
|
||||
(xmltok-g comment-open "-") opt)
|
||||
or (xmltok-g named-markup-declaration
|
||||
ncname))
|
||||
opt))
|
||||
ncname)) opt))
|
||||
(after-lt
|
||||
(xmltok+ markup-declaration
|
||||
or (xmltok-g processing-instruction-question
|
||||
|
|
|
|||
|
|
@ -7430,6 +7430,7 @@ a block. Return a non-nil value when toggling is successful."
|
|||
(org-defkey map [(right)] 'org-goto-right)
|
||||
(org-defkey map [(control ?g)] 'org-goto-quit)
|
||||
(org-defkey map "\C-i" 'org-cycle)
|
||||
(org-defkey map [(tab)] 'org-cycle)
|
||||
(org-defkey map [(down)] 'outline-next-visible-heading)
|
||||
(org-defkey map [(up)] 'outline-previous-visible-heading)
|
||||
(if org-goto-auto-isearch
|
||||
|
|
@ -12998,7 +12999,8 @@ Returns the new TODO keyword, or nil if no state change should occur."
|
|||
(and (= c ?q) (not (rassoc c fulltable))))
|
||||
(setq quit-flag t))
|
||||
((= c ?\ ) nil)
|
||||
((car (rassoc c fulltable)))
|
||||
((setq e (rassoc c fulltable) tg (car e))
|
||||
tg)
|
||||
(t (setq quit-flag t)))))))
|
||||
|
||||
(defun org-entry-is-todo-p ()
|
||||
|
|
@ -15211,11 +15213,11 @@ Returns the new tags string, or nil to not change the current settings."
|
|||
(setq current (delete tg current))
|
||||
(push tg current)))
|
||||
(when exit-after-next (setq exit-after-next 'now)))
|
||||
((setq tg (car (rassoc c todo-table)))
|
||||
((setq e (rassoc c todo-table) tg (car e))
|
||||
(with-current-buffer buf
|
||||
(save-excursion (org-todo tg)))
|
||||
(when exit-after-next (setq exit-after-next 'now)))
|
||||
((setq tg (car (rassoc c ntable)))
|
||||
((setq e (rassoc c ntable) tg (car e))
|
||||
(if (member tg current)
|
||||
(setq current (delete tg current))
|
||||
(cl-loop for g in groups do
|
||||
|
|
@ -17614,28 +17616,27 @@ D may be an absolute day number, or a calendar-type list (month day year)."
|
|||
|
||||
(defun org-diary-sexp-entry (sexp entry d)
|
||||
"Process a SEXP diary ENTRY for date D."
|
||||
;; FIXME: Consolidate with diary-sexp-entry!
|
||||
(require 'diary-lib)
|
||||
;; `org-anniversary' and alike expect ENTRY and DATE to be bound
|
||||
;; dynamically.
|
||||
(let* ((user-sexp (car (read-from-string sexp)))
|
||||
(sexp `(let ((entry ,entry) (date ',d)) ,user-sexp))
|
||||
(let* ((sexp `(let ((entry ,entry)
|
||||
(date ',d))
|
||||
,(car (read-from-string sexp))))
|
||||
(result (if calendar-debug-sexp (eval sexp)
|
||||
(condition-case err
|
||||
(condition-case nil
|
||||
(eval sexp)
|
||||
(error
|
||||
(beep)
|
||||
(message "Bad sexp at line %d in %s: %S\nError: %S"
|
||||
(message "Bad sexp at line %d in %s: %s"
|
||||
(org-current-line)
|
||||
(buffer-file-name) user-sexp err)
|
||||
(buffer-file-name) sexp)
|
||||
(sleep-for 2))))))
|
||||
(cond ((stringp result) (split-string result "; "))
|
||||
((and (consp result)
|
||||
(not (consp (cdr result)))
|
||||
(stringp (cdr result)))
|
||||
(cdr result))
|
||||
((and (consp result) (stringp (car result)))
|
||||
result)
|
||||
(stringp (cdr result))) (cdr result))
|
||||
((and (consp result)
|
||||
(stringp (car result))) result)
|
||||
(result entry))))
|
||||
|
||||
(defun org-diary-to-ical-string (frombuf)
|
||||
|
|
@ -23286,7 +23287,7 @@ major mode."
|
|||
(if (looking-at "\\s-*$") (delete-region (point) (point-at-eol))
|
||||
(open-line 1))
|
||||
(org-indent-line)
|
||||
(insert comment-start)))
|
||||
(insert "# ")))
|
||||
|
||||
(defvar comment-empty-lines) ; From newcomment.el.
|
||||
(defun org-comment-or-uncomment-region (beg end &rest _)
|
||||
|
|
|
|||
|
|
@ -30,7 +30,7 @@
|
|||
;; To use pcomplete with shell-mode, for example, you will need the
|
||||
;; following in your init file:
|
||||
;;
|
||||
;; (add-hook 'shell-mode-hook #'pcomplete-shell-setup)
|
||||
;; (add-hook 'shell-mode-hook 'pcomplete-shell-setup)
|
||||
;;
|
||||
;; Most of the code below simply provides support mechanisms for
|
||||
;; writing completion functions. Completion functions themselves are
|
||||
|
|
@ -129,26 +129,31 @@
|
|||
|
||||
(defcustom pcomplete-file-ignore nil
|
||||
"A regexp of filenames to be disregarded during file completion."
|
||||
:type '(choice regexp (const :tag "None" nil)))
|
||||
:type '(choice regexp (const :tag "None" nil))
|
||||
:group 'pcomplete)
|
||||
|
||||
(defcustom pcomplete-dir-ignore nil
|
||||
"A regexp of names to be disregarded during directory completion."
|
||||
:type '(choice regexp (const :tag "None" nil)))
|
||||
:type '(choice regexp (const :tag "None" nil))
|
||||
:group 'pcomplete)
|
||||
|
||||
(defcustom pcomplete-ignore-case (memq system-type '(ms-dos windows-nt cygwin))
|
||||
;; FIXME: the doc mentions file-name completion, but the code
|
||||
;; seems to apply it to all completions.
|
||||
"If non-nil, ignore case when doing filename completion."
|
||||
:type 'boolean)
|
||||
:type 'boolean
|
||||
:group 'pcomplete)
|
||||
|
||||
(defcustom pcomplete-autolist nil
|
||||
"If non-nil, automatically list possibilities on partial completion.
|
||||
This mirrors the optional behavior of tcsh."
|
||||
:type 'boolean)
|
||||
:type 'boolean
|
||||
:group 'pcomplete)
|
||||
|
||||
(defcustom pcomplete-suffix-list (list ?/ ?:)
|
||||
"A list of characters which constitute a proper suffix."
|
||||
:type '(repeat character))
|
||||
:type '(repeat character)
|
||||
:group 'pcomplete)
|
||||
(make-obsolete-variable 'pcomplete-suffix-list nil "24.1")
|
||||
|
||||
(defcustom pcomplete-recexact nil
|
||||
|
|
@ -156,22 +161,25 @@ This mirrors the optional behavior of tcsh."
|
|||
This mirrors the optional behavior of tcsh.
|
||||
|
||||
A non-nil value is useful if `pcomplete-autolist' is non-nil too."
|
||||
:type 'boolean)
|
||||
:type 'boolean
|
||||
:group 'pcomplete)
|
||||
|
||||
(define-obsolete-variable-alias
|
||||
'pcomplete-arg-quote-list 'comint-file-name-quote-list "24.3")
|
||||
|
||||
(defcustom pcomplete-man-function #'man
|
||||
(defcustom pcomplete-man-function 'man
|
||||
"A function to that will be called to display a manual page.
|
||||
It will be passed the name of the command to document."
|
||||
:type 'function)
|
||||
:type 'function
|
||||
:group 'pcomplete)
|
||||
|
||||
(defcustom pcomplete-compare-entry-function #'string-lessp
|
||||
(defcustom pcomplete-compare-entry-function 'string-lessp
|
||||
"This function is used to order file entries for completion.
|
||||
The behavior of most all shells is to sort alphabetically."
|
||||
:type '(radio (function-item string-lessp)
|
||||
(function-item file-newer-than-file-p)
|
||||
(function :tag "Other")))
|
||||
(function :tag "Other"))
|
||||
:group 'pcomplete)
|
||||
|
||||
(defcustom pcomplete-help nil
|
||||
"A string or function (or nil) used for context-sensitive help.
|
||||
|
|
@ -180,7 +188,8 @@ If non-nil, it must a sexp that will be evaluated, and whose
|
|||
result will be shown in the minibuffer.
|
||||
If nil, the function `pcomplete-man-function' will be called with the
|
||||
current command argument."
|
||||
:type '(choice string sexp (const :tag "Use man page" nil)))
|
||||
:type '(choice string sexp (const :tag "Use man page" nil))
|
||||
:group 'pcomplete)
|
||||
|
||||
(defcustom pcomplete-expand-before-complete nil
|
||||
"If non-nil, expand the current argument before completing it.
|
||||
|
|
@ -190,10 +199,11 @@ resolved first, and the resultant value that will be completed against
|
|||
to be inserted in the buffer. Note that exactly what gets expanded
|
||||
and how is entirely up to the behavior of the
|
||||
`pcomplete-parse-arguments-function'."
|
||||
:type 'boolean)
|
||||
:type 'boolean
|
||||
:group 'pcomplete)
|
||||
|
||||
(defcustom pcomplete-parse-arguments-function
|
||||
#'pcomplete-parse-buffer-arguments
|
||||
'pcomplete-parse-buffer-arguments
|
||||
"A function to call to parse the current line's arguments.
|
||||
It should be called with no parameters, and with point at the position
|
||||
of the argument that is to be completed.
|
||||
|
|
@ -208,7 +218,8 @@ representation of that argument), and BEG-POS gives the beginning
|
|||
position of each argument, as it is seen by the user. The establishes
|
||||
a relationship between the fully resolved value of the argument, and
|
||||
the textual representation of the argument."
|
||||
:type 'function)
|
||||
:type 'function
|
||||
:group 'pcomplete)
|
||||
|
||||
(defcustom pcomplete-cycle-completions t
|
||||
"If non-nil, hitting the TAB key cycles through the completion list.
|
||||
|
|
@ -219,7 +230,8 @@ it acts more like zsh or 4nt, showing the first maximal match first,
|
|||
followed by any further matches on each subsequent pressing of the TAB
|
||||
key. \\[pcomplete-list] is the key to press if the user wants to see
|
||||
the list of possible completions."
|
||||
:type 'boolean)
|
||||
:type 'boolean
|
||||
:group 'pcomplete)
|
||||
|
||||
(defcustom pcomplete-cycle-cutoff-length 5
|
||||
"If the number of completions is greater than this, don't cycle.
|
||||
|
|
@ -234,7 +246,8 @@ has already entered enough input to disambiguate most of the
|
|||
possibilities, and therefore they are probably most interested in
|
||||
cycling through the candidates. Set this value to nil if you want
|
||||
cycling to always be enabled."
|
||||
:type '(choice integer (const :tag "Always cycle" nil)))
|
||||
:type '(choice integer (const :tag "Always cycle" nil))
|
||||
:group 'pcomplete)
|
||||
|
||||
(defcustom pcomplete-restore-window-delay 1
|
||||
"The number of seconds to wait before restoring completion windows.
|
||||
|
|
@ -245,13 +258,15 @@ displayed will be restored), after this many seconds of idle time. If
|
|||
set to nil, completion windows will be left on second until the user
|
||||
removes them manually. If set to 0, they will disappear immediately
|
||||
after the user enters a key other than TAB."
|
||||
:type '(choice integer (const :tag "Never restore" nil)))
|
||||
:type '(choice integer (const :tag "Never restore" nil))
|
||||
:group 'pcomplete)
|
||||
|
||||
(defcustom pcomplete-try-first-hook nil
|
||||
"A list of functions which are called before completing an argument.
|
||||
This can be used, for example, for completing things which might apply
|
||||
to all arguments, such as variable names after a $."
|
||||
:type 'hook)
|
||||
:type 'hook
|
||||
:group 'pcomplete)
|
||||
|
||||
(defsubst pcomplete-executables (&optional regexp)
|
||||
"Complete amongst a list of directories and executables."
|
||||
|
|
@ -295,11 +310,13 @@ generate the completions list. This means that the hook
|
|||
(lambda ()
|
||||
(pcomplete-here (pcomplete-executables))))
|
||||
"Function called for completing the initial command argument."
|
||||
:type 'function)
|
||||
:type 'function
|
||||
:group 'pcomplete)
|
||||
|
||||
(defcustom pcomplete-command-name-function #'pcomplete-command-name
|
||||
(defcustom pcomplete-command-name-function 'pcomplete-command-name
|
||||
"Function called for determining the current command name."
|
||||
:type 'function)
|
||||
:type 'function
|
||||
:group 'pcomplete)
|
||||
|
||||
(defcustom pcomplete-default-completion-function
|
||||
(function
|
||||
|
|
@ -307,14 +324,16 @@ generate the completions list. This means that the hook
|
|||
(while (pcomplete-here (pcomplete-entries)))))
|
||||
"Function called when no completion rule can be found.
|
||||
This function is used to generate completions for every argument."
|
||||
:type 'function)
|
||||
:type 'function
|
||||
:group 'pcomplete)
|
||||
|
||||
(defcustom pcomplete-use-paring t
|
||||
"If t, pare alternatives that have already been used.
|
||||
If nil, you will always see the completion set of possible options, no
|
||||
matter which of those options have already been used in previous
|
||||
command arguments."
|
||||
:type 'boolean)
|
||||
:type 'boolean
|
||||
:group 'pcomplete)
|
||||
|
||||
(defcustom pcomplete-termination-string " "
|
||||
"A string that is inserted after any completion or expansion.
|
||||
|
|
@ -323,7 +342,8 @@ words separated by spaces. However, if your list uses a different
|
|||
separator character, or if the completion occurs in a word that is
|
||||
already terminated by a character, this variable should be locally
|
||||
modified to be an empty string, or the desired separation string."
|
||||
:type 'string)
|
||||
:type 'string
|
||||
:group 'pcomplete)
|
||||
|
||||
;;; Internal Variables:
|
||||
|
||||
|
|
@ -439,7 +459,7 @@ Same as `pcomplete' but using the standard completion UI."
|
|||
;; between pcomplete-stub and the buffer's text is simply due to
|
||||
;; some chars removed by unquoting. Again, this is not
|
||||
;; indispensable but reduces the reliance on c-t-subvert and
|
||||
;; improves corner case behaviors. See e.g. bug#34888.
|
||||
;; improves corner case behaviors.
|
||||
(while (progn (setq buftext (pcomplete-unquote-argument
|
||||
(buffer-substring beg (point))))
|
||||
(and (> beg argbeg)
|
||||
|
|
@ -481,10 +501,6 @@ Same as `pcomplete' but using the standard completion UI."
|
|||
(setq table (completion-table-case-fold table)))
|
||||
(list beg (point) table
|
||||
:predicate pred
|
||||
;; FIXME: This might be useful even if `completions' is nil!
|
||||
:context-help-function
|
||||
(let ((ph pcomplete-help)) ;;Preserve the current value.
|
||||
(lambda () (let ((pcomplete-help ph)) (pcomplete--help))))
|
||||
:exit-function
|
||||
;; If completion is finished, add a terminating space.
|
||||
;; We used to also do this if STATUS is `sole', but
|
||||
|
|
@ -512,7 +528,6 @@ Same as `pcomplete' but using the standard completion UI."
|
|||
"Support extensible programmable completion.
|
||||
To use this function, just bind the TAB key to it, or add it to your
|
||||
completion functions list (it should occur fairly early in the list)."
|
||||
(declare (obsolete "use `completion-at-point' with `pcomplete-completions-at-point' instead" "27.1"))
|
||||
(interactive "p")
|
||||
(if (and interactively
|
||||
pcomplete-cycle-completions
|
||||
|
|
@ -555,7 +570,6 @@ completion functions list (it should occur fairly early in the list)."
|
|||
;;;###autoload
|
||||
(defun pcomplete-reverse ()
|
||||
"If cycling completion is in use, cycle backwards."
|
||||
(declare (obsolete ?? "27.1"))
|
||||
(interactive)
|
||||
(call-interactively 'pcomplete))
|
||||
|
||||
|
|
@ -563,7 +577,6 @@ completion functions list (it should occur fairly early in the list)."
|
|||
(defun pcomplete-expand-and-complete ()
|
||||
"Expand the textual value of the current argument.
|
||||
This will modify the current buffer."
|
||||
(declare (obsolete "use pcomplete-expand and completion-at-point" "27.1"))
|
||||
(interactive)
|
||||
(let ((pcomplete-expand-before-complete t))
|
||||
(pcomplete)))
|
||||
|
|
@ -571,8 +584,6 @@ This will modify the current buffer."
|
|||
;;;###autoload
|
||||
(defun pcomplete-continue ()
|
||||
"Complete without reference to any cycling completions."
|
||||
;; It doesn't seem to be used, so it's OK if we don't have a substitute.
|
||||
(declare (obsolete nil "27.1"))
|
||||
(interactive)
|
||||
(setq pcomplete-current-completions nil
|
||||
pcomplete-last-completion-raw nil)
|
||||
|
|
@ -583,41 +594,30 @@ This will modify the current buffer."
|
|||
"Expand the textual value of the current argument.
|
||||
This will modify the current buffer."
|
||||
(interactive)
|
||||
(setq pcomplete-current-completions nil
|
||||
pcomplete-last-completion-raw nil)
|
||||
(catch 'pcompleted
|
||||
(let* ((pcomplete-stub)
|
||||
pcomplete-seen pcomplete-norm-func
|
||||
pcomplete-args pcomplete-last pcomplete-index
|
||||
(pcomplete-autolist pcomplete-autolist)
|
||||
(pcomplete-suffix-list pcomplete-suffix-list)
|
||||
(pcomplete-expand-only-p t))
|
||||
(pcomplete-parse-arguments 'expand-before-complete)))
|
||||
;; FIXME: What is this doing?
|
||||
(when (and pcomplete-current-completions
|
||||
(> (length pcomplete-current-completions) 0)) ;??
|
||||
(delete-char (- pcomplete-last-completion-length))
|
||||
(dolist (c (prog1 pcomplete-current-completions
|
||||
(setq pcomplete-current-completions nil)))
|
||||
(unless (pcomplete-insert-entry "" c t
|
||||
pcomplete-last-completion-raw)
|
||||
(insert-and-inherit pcomplete-termination-string)))))
|
||||
(let ((pcomplete-expand-before-complete t)
|
||||
(pcomplete-expand-only-p t))
|
||||
(pcomplete)
|
||||
(when (and pcomplete-current-completions
|
||||
(> (length pcomplete-current-completions) 0)) ;??
|
||||
(delete-char (- pcomplete-last-completion-length))
|
||||
(while pcomplete-current-completions
|
||||
(unless (pcomplete-insert-entry
|
||||
"" (car pcomplete-current-completions) t
|
||||
pcomplete-last-completion-raw)
|
||||
(insert-and-inherit pcomplete-termination-string))
|
||||
(setq pcomplete-current-completions
|
||||
(cdr pcomplete-current-completions))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun pcomplete-help ()
|
||||
"Display any help information relative to the current argument."
|
||||
(interactive) ;FIXME!
|
||||
;; (declare (obsolete ?? "27.1"))
|
||||
(let* ((data (pcomplete-completions-at-point))
|
||||
(helpfun (plist-get (nthcdr 3 data) :context-help-function)))
|
||||
(if helpfun
|
||||
(funcall helpfun)
|
||||
(message "No context-sensitive help available"))))
|
||||
(interactive)
|
||||
(let ((pcomplete-show-help t))
|
||||
(pcomplete)))
|
||||
|
||||
;;;###autoload
|
||||
(defun pcomplete-list ()
|
||||
"Show the list of possible completions for the current argument."
|
||||
(declare (obsolete completion-help-at-point "27.1"))
|
||||
(interactive)
|
||||
(when (and pcomplete-cycle-completions
|
||||
pcomplete-current-completions
|
||||
|
|
@ -751,9 +751,9 @@ COMPLETEF-SYM should be the symbol where the
|
|||
dynamic-complete-functions are kept. For comint mode itself,
|
||||
this is `comint-dynamic-complete-functions'."
|
||||
(set (make-local-variable 'pcomplete-parse-arguments-function)
|
||||
#'pcomplete-parse-comint-arguments)
|
||||
'pcomplete-parse-comint-arguments)
|
||||
(add-hook 'completion-at-point-functions
|
||||
#'pcomplete-completions-at-point nil 'local)
|
||||
'pcomplete-completions-at-point nil 'local)
|
||||
(set (make-local-variable completef-sym)
|
||||
(copy-sequence (symbol-value completef-sym)))
|
||||
(let* ((funs (symbol-value completef-sym))
|
||||
|
|
@ -915,12 +915,12 @@ component, `default-directory' is used as the basis for completion."
|
|||
(or (eq action t)
|
||||
(eq (car-safe action) 'boundaries))))
|
||||
(let ((newstring
|
||||
(mapconcat #'identity (nreverse (cons string strings)) "")))
|
||||
(mapconcat 'identity (nreverse (cons string strings)) "")))
|
||||
;; FIXME: We could also try to return unexpanded envvars.
|
||||
(complete-with-action action table newstring pred))
|
||||
(let* ((envpos (apply #'+ (mapcar #' length strings)))
|
||||
(newstring
|
||||
(mapconcat #'identity (nreverse (cons string strings)) ""))
|
||||
(mapconcat 'identity (nreverse (cons string strings)) ""))
|
||||
(bounds (completion-boundaries newstring table pred
|
||||
(or (cdr-safe action) ""))))
|
||||
(if (>= (car bounds) envpos)
|
||||
|
|
@ -1181,12 +1181,12 @@ extra checking, and munging of the COMPLETIONS list."
|
|||
;; pare it down, if applicable
|
||||
(when (and pcomplete-use-paring pcomplete-seen)
|
||||
(setq pcomplete-seen
|
||||
(mapcar #'directory-file-name pcomplete-seen))
|
||||
(mapcar 'directory-file-name pcomplete-seen))
|
||||
(dolist (p pcomplete-seen)
|
||||
(add-to-list 'pcomplete-seen
|
||||
(funcall pcomplete-norm-func p)))
|
||||
(setq completions
|
||||
(apply-partially #'completion-table-with-predicate
|
||||
(apply-partially 'completion-table-with-predicate
|
||||
completions
|
||||
(when pcomplete-seen
|
||||
(lambda (f)
|
||||
|
|
@ -1262,21 +1262,20 @@ See also `pcomplete-filename'."
|
|||
(defun pcomplete--help ()
|
||||
"Produce context-sensitive help for the current argument.
|
||||
If specific documentation can't be given, be generic."
|
||||
(cond
|
||||
((functionp pcomplete-help) (funcall pcomplete-help))
|
||||
((consp pcomplete-help)
|
||||
(message "%s" (eval pcomplete-help t)))
|
||||
((and (stringp pcomplete-help)
|
||||
(fboundp 'Info-goto-node))
|
||||
(save-window-excursion (info))
|
||||
(switch-to-buffer-other-window "*info*")
|
||||
(Info-goto-node pcomplete-help))
|
||||
(t
|
||||
(if (and pcomplete-help
|
||||
(or (and (stringp pcomplete-help)
|
||||
(fboundp 'Info-goto-node))
|
||||
(listp pcomplete-help)))
|
||||
(if (listp pcomplete-help)
|
||||
(message "%s" (eval pcomplete-help))
|
||||
(save-window-excursion (info))
|
||||
(switch-to-buffer-other-window "*info*")
|
||||
(funcall (symbol-function 'Info-goto-node) pcomplete-help))
|
||||
(if pcomplete-man-function
|
||||
(let ((cmd (funcall pcomplete-command-name-function)))
|
||||
(if (and cmd (> (length cmd) 0))
|
||||
(funcall pcomplete-man-function cmd)))
|
||||
(message "No context-sensitive help available")))))
|
||||
(message "No context-sensitive help available"))))
|
||||
|
||||
;; general utilities
|
||||
|
||||
|
|
@ -1293,12 +1292,12 @@ If specific documentation can't be given, be generic."
|
|||
l)
|
||||
(define-obsolete-function-alias
|
||||
'pcomplete-uniqify-list
|
||||
#'pcomplete-uniquify-list "27.1")
|
||||
'pcomplete-uniquify-list "27.1")
|
||||
|
||||
(defun pcomplete-process-result (cmd &rest args)
|
||||
"Call CMD using `call-process' and return the simplest result."
|
||||
(with-temp-buffer
|
||||
(apply #'call-process cmd nil t nil args)
|
||||
(apply 'call-process cmd nil t nil args)
|
||||
(skip-chars-backward "\n")
|
||||
(buffer-substring (point-min) (point))))
|
||||
|
||||
|
|
|
|||
|
|
@ -525,8 +525,6 @@ preferably use the `c-mode-menu' language constant directly."
|
|||
;; and `after-change-functions'. Note that this variable is not set when
|
||||
;; `c-before-change' is invoked by a change to text properties.
|
||||
|
||||
(defvar c--use-syntax-propertize t)
|
||||
|
||||
(defun c-basic-common-init (mode default-style)
|
||||
"Do the necessary initialization for the syntax handling routines
|
||||
and the line breaking/filling code. Intended to be used by other
|
||||
|
|
@ -671,20 +669,15 @@ that requires a literal mode spec at compile time."
|
|||
|
||||
;; Install the functions that ensure that various internal caches
|
||||
;; don't become invalid due to buffer changes.
|
||||
(if c--use-syntax-propertize
|
||||
(setq-local syntax-propertize-function
|
||||
(lambda (start end)
|
||||
(c-before-change start (point-max))
|
||||
(c-after-change start end (- end start))))
|
||||
(when (featurep 'xemacs)
|
||||
(make-local-hook 'before-change-functions)
|
||||
(make-local-hook 'after-change-functions))
|
||||
(add-hook 'before-change-functions 'c-before-change nil t)
|
||||
(setq c-just-done-before-change nil)
|
||||
;; FIXME: We should use the new `depth' arg in Emacs-27 (e.g. a depth of -10
|
||||
;; would do since font-lock uses a(n implicit) depth of 0) so we don't need
|
||||
;; c-after-font-lock-init.
|
||||
(add-hook 'after-change-functions 'c-after-change nil t))
|
||||
(when (featurep 'xemacs)
|
||||
(make-local-hook 'before-change-functions)
|
||||
(make-local-hook 'after-change-functions))
|
||||
(add-hook 'before-change-functions 'c-before-change nil t)
|
||||
(setq c-just-done-before-change nil)
|
||||
;; FIXME: We should use the new `depth' arg in Emacs-27 (e.g. a depth of -10
|
||||
;; would do since font-lock uses a(n implicit) depth of 0) so we don't need
|
||||
;; c-after-font-lock-init.
|
||||
(add-hook 'after-change-functions 'c-after-change nil t)
|
||||
(when (boundp 'font-lock-extend-after-change-region-function)
|
||||
(set (make-local-variable 'font-lock-extend-after-change-region-function)
|
||||
'c-extend-after-change-region))) ; Currently (2009-05) used by all
|
||||
|
|
@ -742,17 +735,15 @@ compatible with old code; callers should always specify it."
|
|||
(widen)
|
||||
(setq c-new-BEG (point-min))
|
||||
(setq c-new-END (point-max))
|
||||
(unless c--use-syntax-propertize
|
||||
(save-excursion
|
||||
(let (before-change-functions after-change-functions)
|
||||
(mapc (lambda (fn)
|
||||
(funcall fn (point-min) (point-max)))
|
||||
c-get-state-before-change-functions)
|
||||
(mapc (lambda (fn)
|
||||
(funcall fn (point-min) (point-max)
|
||||
(- (point-max) (point-min))))
|
||||
c-before-font-lock-functions)
|
||||
))))
|
||||
(save-excursion
|
||||
(let (before-change-functions after-change-functions)
|
||||
(mapc (lambda (fn)
|
||||
(funcall fn (point-min) (point-max)))
|
||||
c-get-state-before-change-functions)
|
||||
(mapc (lambda (fn)
|
||||
(funcall fn (point-min) (point-max)
|
||||
(- (point-max) (point-min))))
|
||||
c-before-font-lock-functions))))
|
||||
|
||||
(set (make-local-variable 'outline-regexp) "[^#\n\^M]")
|
||||
(set (make-local-variable 'outline-level) 'c-outline-level)
|
||||
|
|
@ -2059,12 +2050,6 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
|
|||
;;
|
||||
;; Type a space in the first blank line, and the fontification of the next
|
||||
;; line was fouled up by context fontification.
|
||||
(when c--use-syntax-propertize
|
||||
;; This should also update c-new-END and c-new-BEG.
|
||||
(syntax-propertize end)
|
||||
;; FIXME: Apparently `c-new-END' may be left unchanged to a stale value,
|
||||
;; presumably when the buffer gets truncated.
|
||||
(if (> c-new-END (point-max)) (setq c-new-END (point-max))))
|
||||
(let (new-beg new-end new-region case-fold-search)
|
||||
(if (and c-in-after-change-fontification
|
||||
(< beg c-new-END) (> end c-new-BEG))
|
||||
|
|
@ -2103,8 +2088,7 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
|
|||
(defun c-after-font-lock-init ()
|
||||
;; Put on `font-lock-mode-hook'. This function ensures our after-change
|
||||
;; function will get executed before the font-lock one.
|
||||
(when (and c--use-syntax-propertize
|
||||
(memq #'c-after-change after-change-functions))
|
||||
(when (memq #'c-after-change after-change-functions)
|
||||
(remove-hook 'after-change-functions #'c-after-change t)
|
||||
(add-hook 'after-change-functions #'c-after-change nil t)))
|
||||
|
||||
|
|
@ -2158,14 +2142,11 @@ This function is called from `c-common-init', once per mode initialization."
|
|||
(when (eq font-lock-support-mode 'jit-lock-mode)
|
||||
(save-restriction
|
||||
(widen)
|
||||
;; FIXME: This presumes that c-new-BEG and c-new-END have been set
|
||||
;; I guess from the before-change-function.
|
||||
(c-save-buffer-state () ; Protect the undo-list from put-text-property.
|
||||
(if (< c-new-BEG beg)
|
||||
(put-text-property c-new-BEG beg 'fontified nil))
|
||||
(if (> c-new-END end)
|
||||
(put-text-property end (min c-new-END (point-max))
|
||||
'fontified nil)))))
|
||||
(put-text-property end c-new-END 'fontified nil)))))
|
||||
(cons c-new-BEG c-new-END))
|
||||
|
||||
;; Emacs < 22 and XEmacs
|
||||
|
|
|
|||
|
|
@ -480,7 +480,8 @@ Older version of this page was called `perl5', newer `perl'."
|
|||
:type 'string
|
||||
:group 'cperl-help-system)
|
||||
|
||||
(defcustom cperl-use-syntax-table-text-property t
|
||||
(defcustom cperl-use-syntax-table-text-property
|
||||
(boundp 'parse-sexp-lookup-properties)
|
||||
"Non-nil means CPerl sets up and uses `syntax-table' text property."
|
||||
:type 'boolean
|
||||
:group 'cperl-speed)
|
||||
|
|
@ -699,7 +700,55 @@ install choose-color.el, available from
|
|||
|
||||
`fill-paragraph' on a comment may leave the point behind the
|
||||
paragraph. It also triggers a bug in some versions of Emacs (CPerl tries
|
||||
to detect it and bulk out).")
|
||||
to detect it and bulk out).
|
||||
|
||||
See documentation of a variable `cperl-problems-old-emaxen' for the
|
||||
problems which disappear if you upgrade Emacs to a reasonably new
|
||||
version (20.3 for Emacs, and those of 2004 for XEmacs).")
|
||||
|
||||
(defvar cperl-problems-old-emaxen 'please-ignore-this-line
|
||||
"Description of problems in CPerl mode specific for older Emacs versions.
|
||||
|
||||
Emacs had a _very_ restricted syntax parsing engine until version
|
||||
20.1. Most problems below are corrected starting from this version of
|
||||
Emacs, and all of them should be fixed in version 20.3. (Or apply
|
||||
patches to Emacs 19.33/34 - see tips.) XEmacs was very backward in
|
||||
this respect (until 2003).
|
||||
|
||||
Note that even with newer Emacsen in some very rare cases the details
|
||||
of interaction of `font-lock' and syntaxification may be not cleaned
|
||||
up yet. You may get slightly different colors basing on the order of
|
||||
fontification and syntaxification. Say, the initial faces is correct,
|
||||
but editing the buffer breaks this.
|
||||
|
||||
Even with older Emacsen CPerl mode tries to corrects some Emacs
|
||||
misunderstandings, however, for efficiency reasons the degree of
|
||||
correction is different for different operations. The partially
|
||||
corrected problems are: POD sections, here-documents, regexps. The
|
||||
operations are: highlighting, indentation, electric keywords, electric
|
||||
braces.
|
||||
|
||||
This may be confusing, since the regexp s#//#/#; may be highlighted
|
||||
as a comment, but it will be recognized as a regexp by the indentation
|
||||
code. Or the opposite case, when a POD section is highlighted, but
|
||||
may break the indentation of the following code (though indentation
|
||||
should work if the balance of delimiters is not broken by POD).
|
||||
|
||||
The main trick (to make $ a \"backslash\") makes constructions like
|
||||
${aaa} look like unbalanced braces. The only trick I can think of is
|
||||
to insert it as $ {aaa} (valid in perl5, not in perl4).
|
||||
|
||||
Similar problems arise in regexps, when /(\\s|$)/ should be rewritten
|
||||
as /($|\\s)/. Note that such a transposition is not always possible.
|
||||
|
||||
The solution is to upgrade your Emacs or patch an older one. Note
|
||||
that Emacs 20.2 has some bugs related to `syntax-table' text
|
||||
properties. Patches are available on the main CPerl download site,
|
||||
and on CPAN.
|
||||
|
||||
If these bugs cannot be fixed on your machine (say, you have an inferior
|
||||
environment and cannot recompile), you may still disable all the fancy stuff
|
||||
via `cperl-use-syntax-table-text-property'.")
|
||||
|
||||
(defvar cperl-praise 'please-ignore-this-line
|
||||
"Advantages of CPerl mode.
|
||||
|
|
|
|||
|
|
@ -152,8 +152,7 @@ Used to gray out relevant toolbar icons.")
|
|||
(bound-and-true-p
|
||||
gdb-active-process)))))
|
||||
([go] menu-item (if (bound-and-true-p gdb-active-process)
|
||||
"Continue" "Run")
|
||||
gud-go
|
||||
"Continue" "Run") gud-go
|
||||
:visible (and (eq gud-minor-mode 'gdbmi)
|
||||
(gdb-show-run-p)))
|
||||
([stop] menu-item "Stop" gud-stop-subjob
|
||||
|
|
@ -191,8 +190,7 @@ Used to gray out relevant toolbar icons.")
|
|||
(eq gud-minor-mode 'gdbmi)))
|
||||
([print*] menu-item (if (eq gud-minor-mode 'jdb)
|
||||
"Dump object"
|
||||
"Print Dereference")
|
||||
gud-pstar
|
||||
"Print Dereference") gud-pstar
|
||||
:enable (not gud-running)
|
||||
:visible (memq gud-minor-mode '(gdbmi gdb jdb)))
|
||||
([print] menu-item "Print Expression" gud-print
|
||||
|
|
|
|||
|
|
@ -33,11 +33,12 @@
|
|||
;;; Added by Tom Perrine (TEP)
|
||||
(defvar m2-mode-syntax-table
|
||||
(let ((table (make-syntax-table)))
|
||||
;; FIXME: nesting!
|
||||
;; FIXME: `comment-indent' just inserts "(**)" whereas the old code
|
||||
;; resulted in a nicer "(* *)"!
|
||||
(comment-set-syntax table '(("(*" . "*)") ("//" . "\n")))
|
||||
(modify-syntax-entry ?\\ "\\" table)
|
||||
(modify-syntax-entry ?/ ". 12" table)
|
||||
(modify-syntax-entry ?\n ">" table)
|
||||
(modify-syntax-entry ?\( "()1" table)
|
||||
(modify-syntax-entry ?\) ")(4" table)
|
||||
(modify-syntax-entry ?* ". 23nb" table)
|
||||
(modify-syntax-entry ?+ "." table)
|
||||
(modify-syntax-entry ?- "." table)
|
||||
(modify-syntax-entry ?= "." table)
|
||||
|
|
@ -203,11 +204,10 @@
|
|||
(let ((tok (smie-default-backward-token)))
|
||||
(cond
|
||||
((zerop (length tok))
|
||||
(if (bobp) (setq res ":")
|
||||
(let ((forward-sexp-function nil))
|
||||
(condition-case nil
|
||||
(forward-sexp -1)
|
||||
(scan-error (setq res ":"))))))
|
||||
(let ((forward-sexp-function nil))
|
||||
(condition-case nil
|
||||
(forward-sexp -1)
|
||||
(scan-error (setq res ":")))))
|
||||
((member tok '("|" "OF" "..")) (setq res ":-case"))
|
||||
((member tok '(":" "END" ";" "BEGIN" "VAR" "RECORD" "PROCEDURE"))
|
||||
(setq res ":")))))
|
||||
|
|
@ -311,6 +311,9 @@ followed by the first character of the construct.
|
|||
(set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter))
|
||||
(set (make-local-variable 'paragraph-separate) paragraph-start)
|
||||
(set (make-local-variable 'paragraph-ignore-fill-prefix) t)
|
||||
(set (make-local-variable 'comment-start) "(* ")
|
||||
(set (make-local-variable 'comment-end) " *)")
|
||||
(set (make-local-variable 'comment-start-skip) "\\(?:(\\*+\\|//+\\) *")
|
||||
(set (make-local-variable 'parse-sexp-ignore-comments) t)
|
||||
(set (make-local-variable 'font-lock-defaults)
|
||||
'((m3-font-lock-keywords
|
||||
|
|
|
|||
|
|
@ -628,8 +628,7 @@ builtins.")
|
|||
;; OS specific
|
||||
"VMSError" "WindowsError"
|
||||
)
|
||||
symbol-end)
|
||||
. font-lock-type-face)
|
||||
symbol-end) . font-lock-type-face)
|
||||
;; assignments
|
||||
;; support for a = b = c = 5
|
||||
(,(lambda (limit)
|
||||
|
|
@ -679,7 +678,6 @@ Which one will be chosen depends on the value of
|
|||
((rx (or "\"\"\"" "'''"))
|
||||
(0 (ignore (python-syntax-stringify))))))
|
||||
|
||||
;; Always define the alias(es) *before* the variable.
|
||||
(define-obsolete-variable-alias 'python--prettify-symbols-alist
|
||||
'python-prettify-symbols-alist "26.1")
|
||||
|
||||
|
|
|
|||
|
|
@ -980,13 +980,6 @@ XDG convention for dotfiles."
|
|||
(found-path (if (file-exists-p xdg-path) xdg-path oldstyle-path)))
|
||||
found-path))
|
||||
|
||||
(defcustom gc-cons-opportunistic-idle-time 5
|
||||
"Number of seconds before trying an opportunistic GC.
|
||||
After this number of seconds of idle time, Emacs tries to collect
|
||||
garbage more eagerly (i.e. with thresholds halved) in the hope
|
||||
to avoid running the GC later during non-idle time."
|
||||
:type 'integer)
|
||||
|
||||
(defun command-line ()
|
||||
"A subroutine of `normal-top-level'.
|
||||
Amongst another things, it parses the command-line arguments."
|
||||
|
|
@ -1384,16 +1377,6 @@ please check its value")
|
|||
(eq face-ignored-fonts old-face-ignored-fonts))
|
||||
(clear-face-cache)))
|
||||
|
||||
;; Start opportunistic GC (after loading the init file, so we obey
|
||||
;; its settings). This is desirable for two reason:
|
||||
;; - It reduces the number of times we have to GC in the middle of
|
||||
;; an operation.
|
||||
;; - It means we GC when the C stack is short, reducing the risk of false
|
||||
;; positives from the conservative stack scanning.
|
||||
(when gc-cons-opportunistic-idle-time
|
||||
(run-with-idle-timer gc-cons-opportunistic-idle-time t
|
||||
#'garbage-collect-maybe 2))
|
||||
|
||||
(setq after-init-time (current-time))
|
||||
;; Display any accumulated warnings after all functions in
|
||||
;; `after-init-hook' like `desktop-read' have finalized possible
|
||||
|
|
|
|||
23
lisp/subr.el
23
lisp/subr.el
|
|
@ -825,11 +825,11 @@ Example:
|
|||
"Return a copy of SEQ with all occurrences of ELT removed.
|
||||
SEQ must be a list, vector, or string. The comparison is done with `equal'."
|
||||
(declare (side-effect-free t))
|
||||
(delete elt (if (nlistp seq)
|
||||
;; If SEQ isn't a list, there's no need to copy SEQ because
|
||||
;; `delete' will return a new object.
|
||||
seq
|
||||
(copy-sequence seq))))
|
||||
(if (nlistp seq)
|
||||
;; If SEQ isn't a list, there's no need to copy SEQ because
|
||||
;; `delete' will return a new object.
|
||||
(delete elt seq)
|
||||
(delete elt (copy-sequence seq))))
|
||||
|
||||
(defun remq (elt list)
|
||||
"Return LIST with all occurrences of ELT removed.
|
||||
|
|
@ -851,10 +851,10 @@ This is the same format used for saving keyboard macros (see
|
|||
`edmacro-mode').
|
||||
|
||||
For an approximate inverse of this, see `key-description'."
|
||||
(declare (pure t))
|
||||
;; Don't use a defalias, since the `pure' property is only true for
|
||||
;; the calling convention of `kbd'.
|
||||
(read-kbd-macro keys))
|
||||
(put 'kbd 'pure t)
|
||||
|
||||
(defun undefined ()
|
||||
"Beep to tell the user this binding is undefined."
|
||||
|
|
@ -5586,17 +5586,6 @@ returned list are in the same order as in TREE.
|
|||
(defalias 'flatten-list 'flatten-tree)
|
||||
|
||||
;; The initial anchoring is for better performance in searching matches.
|
||||
(defun internal--opportunistic-gc ()
|
||||
"Run the GC during idle time."
|
||||
(let ((gc-cons-threshold (/ gc-cons-threshold 2))
|
||||
;; FIXME: This doesn't work because it's only consulted at the end
|
||||
;; of a GC in order to set the next `gc_relative_threshold'!
|
||||
(gc-cons-percentage (/ gc-cons-percentage 2)))
|
||||
;; HACK ATTACK: the purpose of this dummy call to `eval' is to call
|
||||
;; `maybe_gc', so we will trigger a GC if we allocated half of the maximum
|
||||
;; allowed before the GC is forced upon us.
|
||||
(eval 1 t)))
|
||||
|
||||
(defconst regexp-unmatchable "\\`a\\`"
|
||||
"Standard regexp guaranteed not to match any string at all.")
|
||||
|
||||
|
|
|
|||
|
|
@ -1107,7 +1107,6 @@ versions of xterm."
|
|||
(t (error "Unsupported number of xterm colors (%d)" (+ 16 ncolors)))))
|
||||
;; Modifying color mappings means realized faces don't use the
|
||||
;; right colors, so clear them.
|
||||
;; FIXME: Only for the selected frame!
|
||||
(clear-face-cache)))
|
||||
|
||||
(defun xterm-maybe-set-dark-background-mode (redc greenc bluec)
|
||||
|
|
|
|||
|
|
@ -1115,7 +1115,7 @@ to exclude some SCSS constructs."
|
|||
(goto-char start-point)
|
||||
(forward-comment (- (point)))
|
||||
(skip-chars-backward "@[:alpha:]")
|
||||
(unless (looking-at-p "@\\(?:mixin\\|include\\)")
|
||||
(unless (looking-at-p "@\\(mixin\\|include\\)")
|
||||
(cdr color)))))
|
||||
|
||||
(defun css--compute-color (start-point match)
|
||||
|
|
|
|||
|
|
@ -900,12 +900,6 @@ region, instead of just filling the current paragraph."
|
|||
(equal hash (buffer-hash)))
|
||||
(set-buffer-modified-p nil)))))
|
||||
|
||||
(defun unfill-paragraph ()
|
||||
"That thing."
|
||||
(interactive)
|
||||
(let ((fill-column (/ most-positive-fixnum 2)))
|
||||
(fill-paragraph)))
|
||||
|
||||
(declare-function comment-search-forward "newcomment" (limit &optional noerror))
|
||||
(declare-function comment-string-strip "newcomment" (str beforep afterp))
|
||||
|
||||
|
|
|
|||
|
|
@ -6485,7 +6485,7 @@ pass the elements of (cdr ARGS) as the remaining arguments."
|
|||
(set-window-dedicated-p window t)
|
||||
window)))))
|
||||
|
||||
(defcustom special-display-function #'special-display-popup-frame
|
||||
(defcustom special-display-function 'special-display-popup-frame
|
||||
"Function to call for displaying special buffers.
|
||||
This function is called with two arguments - the buffer and,
|
||||
optionally, a list - and should return a window displaying that
|
||||
|
|
|
|||
|
|
@ -84,7 +84,7 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)."
|
|||
(setf (terminal-parameter nil 'xterm-mouse-last-down) nil)
|
||||
(cond
|
||||
((null down)
|
||||
;; This is an "up-only" event. Pretend there was a down-event
|
||||
;; This is an "up-only" event. Pretend there was an up-event
|
||||
;; right before and keep the up-event for later.
|
||||
(push event unread-command-events)
|
||||
(vector (cons (intern (replace-regexp-in-string
|
||||
|
|
|
|||
23
src/alloc.c
23
src/alloc.c
|
|
@ -5989,28 +5989,6 @@ garbage_collect (void)
|
|||
garbage_collect_1 (&gcst);
|
||||
}
|
||||
|
||||
DEFUN ("garbage-collect-maybe", Fgarbage_collect_maybe, Sgarbage_collect_maybe, 1, 1, "",
|
||||
doc: /* Call `garbage-collect' if enough allocation happened.
|
||||
FACTOR determines what "enough" means here:
|
||||
a FACTOR of N means to run the GC if more than 1/Nth of the allocations
|
||||
needed to triger automatic allocation took place. */)
|
||||
(Lisp_Object factor)
|
||||
{
|
||||
CHECK_FIXNAT (factor);
|
||||
EMACS_INT fact = XFIXNAT (factor);
|
||||
byte_ct new_csgc = consing_since_gc * fact;
|
||||
if (new_csgc / fact != consing_since_gc)
|
||||
/* Overflow! */
|
||||
garbage_collect ();
|
||||
else
|
||||
{
|
||||
consing_since_gc = new_csgc;
|
||||
maybe_gc ();
|
||||
consing_since_gc /= fact;
|
||||
}
|
||||
return Qnil;
|
||||
}
|
||||
|
||||
DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "",
|
||||
doc: /* Reclaim storage for Lisp objects no longer needed.
|
||||
Garbage collection happens automatically if you cons more than
|
||||
|
|
@ -7411,7 +7389,6 @@ N should be nonnegative. */);
|
|||
defsubr (&Smake_finalizer);
|
||||
defsubr (&Spurecopy);
|
||||
defsubr (&Sgarbage_collect);
|
||||
defsubr (&Sgarbage_collect_maybe);
|
||||
defsubr (&Smemory_info);
|
||||
defsubr (&Smemory_use_counts);
|
||||
defsubr (&Ssuspicious_object);
|
||||
|
|
|
|||
|
|
@ -2728,7 +2728,7 @@ read_char (int commandflag, Lisp_Object map,
|
|||
|
||||
/* If there is still no input available, ask for GC. */
|
||||
if (!detect_input_pending_run_timers (0))
|
||||
maybe_gc (); /* FIXME: Why? */
|
||||
maybe_gc ();
|
||||
}
|
||||
|
||||
/* Notify the caller if an autosave hook, or a timer, sentinel or
|
||||
|
|
|
|||
|
|
@ -876,6 +876,15 @@ baz\"\""
|
|||
(call-interactively (key-binding `[,last-command-event])))
|
||||
(should (equal (buffer-string) "int main () {\n \n}"))))
|
||||
|
||||
(define-derived-mode plainer-c-mode c-mode "pC"
|
||||
"A plainer/saner C-mode with no internal electric machinery."
|
||||
(c-toggle-electric-state -1)
|
||||
(setq-local electric-indent-local-mode-hook nil)
|
||||
(setq-local electric-indent-mode-hook nil)
|
||||
(electric-indent-local-mode 1)
|
||||
(dolist (key '(?\" ?\' ?\{ ?\} ?\( ?\) ?\[ ?\]))
|
||||
(local-set-key (vector key) 'self-insert-command)))
|
||||
|
||||
(ert-deftest electric-modes-int-main-allman-style ()
|
||||
(ert-with-test-buffer ()
|
||||
(plainer-c-mode)
|
||||
|
|
|
|||
|
|
@ -74,7 +74,7 @@
|
|||
'completion-table-with-predicate
|
||||
full-collection no-A nil))))))
|
||||
|
||||
(ert-deftest completion-table-subvert-test () ;bug#34888
|
||||
(ert-deftest completion-table-subvert-test ()
|
||||
(let* ((origtable '("A-hello" "A-there"))
|
||||
(subvtable (completion-table-subvert origtable "B" "A")))
|
||||
(should (equal (try-completion "B-hel" subvtable)
|
||||
|
|
|
|||
|
|
@ -3885,7 +3885,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
|
|||
:tags '(:expensive-test)
|
||||
(skip-unless (tramp--test-enabled))
|
||||
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
|
||||
(defvar tramp-display-escape-sequence-regexp) ;Defined in tramp-sh.el
|
||||
|
||||
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
|
||||
(let* ((tmp-name (tramp--test-make-temp-name nil quoted))
|
||||
(fnnd (file-name-nondirectory tmp-name))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue