commit 8bc5bd5b03cfc1994734b5903f98dccc0cdf004f (HEAD, refs/remotes/origin/master) Author: Lars Ingebrigtsen Date: Tue Dec 15 08:43:41 2020 +0100 Fix electric pairs in rst-mode * lisp/textmodes/rst.el (rst-mode-syntax-table): Mark pairs in the syntax table (bug#23413). (rst-mode): Instead of setting electric-pair-pairs. diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 7a7ac478b7..435de2683e 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -1302,7 +1302,8 @@ This inherits from Text mode.") (modify-syntax-entry ?% "." st) (modify-syntax-entry ?& "." st) (modify-syntax-entry ?' "." st) - (modify-syntax-entry ?* "." st) + (modify-syntax-entry ?` "\"` " st) + (modify-syntax-entry ?* "\"* " st) (modify-syntax-entry ?+ "." st) (modify-syntax-entry ?- "." st) (modify-syntax-entry ?/ "." st) @@ -1330,7 +1331,6 @@ The hook for `text-mode' is run before this one." ;; Pull in variable definitions silencing byte-compiler. (require 'newcomment) -(defvar electric-pair-pairs) (defvar electric-indent-inhibit) ;; Use rst-mode for *.rst and *.rest files. Many ReStructured-Text files @@ -1387,8 +1387,6 @@ highlighting. (setq-local comment-region-function #'rst-comment-region) (setq-local uncomment-region-function #'rst-uncomment-region) - (setq-local electric-pair-pairs '((?\" . ?\") (?\* . ?\*) (?\` . ?\`))) - ;; Imenu and which function. ;; FIXME: Check documentation of `which-function' for alternative ways to ;; determine the current function name. commit 3806797583a22ad520e64f7fc35d893840f0d563 Author: Lars Ingebrigtsen Date: Tue Dec 15 07:18:03 2020 +0100 Bind current-minibuffer-command to this-command * src/callint.c (Fcall_interactively): Bind current-minibuffer-command to this-command, as documented (bug#45177). diff --git a/src/callint.c b/src/callint.c index a221705f67..d172af9e30 100644 --- a/src/callint.c +++ b/src/callint.c @@ -286,7 +286,7 @@ invoke it (via an `interactive' spec that contains, for instance, an /* Bound recursively so that code can check the current command from code running from minibuffer hooks (and the like), without being overwritten by subsequent minibuffer calls. */ - specbind (Qcurrent_minibuffer_command, Vreal_this_command); + specbind (Qcurrent_minibuffer_command, Vthis_command); if (NILP (keys)) keys = this_command_keys, key_count = this_command_key_count; commit fd4297b25a61b33340ef312355748512e702bc2c Author: Glenn Morris Date: Mon Dec 14 13:51:22 2020 -0800 * doc/lispref/errors.texi (Standard Errors): Fix xref. Though I am not sure "report a bug" is helpful. diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi index ff9b3e5712..a386a41bd3 100644 --- a/doc/lispref/errors.texi +++ b/doc/lispref/errors.texi @@ -135,8 +135,8 @@ problems in accessing a remote file. @xref{Remote Files,,, emacs, The GNU Emacs Manual}. Often, this error appears when timers, process filters, process sentinels or special events in general try to access a remote file, and collide with another remote file operation. In -general it is a good idea to write a bug report. @xref{Reporting -Bugs,,, emacs, The GNU Emacs Manual}. +general it is a good idea to write a bug report. +@xref{Bugs,,, emacs, The GNU Emacs Manual}. @c net/ange-ftp.el @item ftp-error commit d148f1090fb53e5a360d316c89f241c839c44068 Author: Glenn Morris Date: Mon Dec 14 13:46:35 2020 -0800 * doc/emacs/indent.texi (Indent Convenience): Fix use of @xref. diff --git a/doc/emacs/indent.texi b/doc/emacs/indent.texi index d6395ef155..e8b4650633 100644 --- a/doc/emacs/indent.texi +++ b/doc/emacs/indent.texi @@ -255,7 +255,7 @@ indentation; otherwise, it inserts a tab character. indent can be further customized via the @code{tab-first-completion} variable. For instance, if that variable is @code{eol}, only complete if point is at the end of a line. @xref{Mode-Specific Indent,,, -elisp, The Emacs Lisp Reference Manual} for further details. +elisp, The Emacs Lisp Reference Manual}, for further details. @cindex Electric Indent mode @cindex mode, Electric Indent commit 7e30cb2c1c2889965a1b1740905889a32f757461 Author: Glenn Morris Date: Mon Dec 14 13:45:29 2020 -0800 Tiny fix for lispref/variables.texi * doc/lispref/variables.texi (Converting to Lexical Binding): @strong{Note...} produces a spurious cross-reference in Info; reword to avoid that. diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index b9ff074738..9447e8d04c 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -1287,7 +1287,7 @@ be used.) @subsubheading Cross-file variable checking -@strong{Note:} This is an experimental feature that may change or +@strong{Caution:} This is an experimental feature that may change or disappear without prior notice. The byte-compiler can also warn about lexical variables that are commit 485898c18b8ce665a6539ad6be6ccf1b8bece0c6 Author: Stefan Monnier Date: Mon Dec 14 16:16:01 2020 -0500 * lisp/emacs-lisp/gv.el (error): Allow it as a place diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index 5470b8532f..7ee5c47d11 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -504,6 +504,11 @@ The return value is the last VAL in the list. (funcall do `(funcall (car ,gv)) (lambda (v) `(funcall (cdr ,gv) ,v)))))))) +(put 'error 'gv-expander + (lambda (do &rest args) + (funcall do `(error . ,args) + (lambda (v) `(progn ,v (error . ,args)))))) + (defmacro gv-synthetic-place (getter setter) "Special place described by its setter and getter. GETTER and SETTER (typically obtained via `gv-letplace') get and commit 071bfd9840b1048bdc4f2c461fe50bd33dc919e8 Author: Alan Mackenzie Date: Mon Dec 14 20:44:33 2020 +0000 Optimise c-font-lock-<>-arglists, particularly for buffers with few <..> pairs * lisp/progmodes/cc-fonts.el (c-font-lock-<>-arglists): In place of a regexp search for a complicated and slow regexp, search simply for "<" ouside of literals together with add hoc testing of other requirements for a <...> match. * lisp/progmodes/cc-langs.el (c-nonsymbol-key): New c-lang-defvar from the c-lang-const. diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index bb7e5bea6e..38166c27ec 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1008,66 +1008,75 @@ casts and declarations are fontified. Used on level 2 and higher." (boundp 'parse-sexp-lookup-properties))) (c-parse-and-markup-<>-arglists t) c-restricted-<>-arglists - id-start id-end id-face pos kwd-sym) + id-start id-end id-face pos kwd-sym + old-pos) (while (and (< (point) limit) - (re-search-forward c-opt-<>-arglist-start limit t)) - - (setq id-start (match-beginning 1) - id-end (match-end 1) - pos (point)) - - (goto-char id-start) - (unless (c-skip-comments-and-strings limit) - (setq kwd-sym nil - c-restricted-<>-arglists nil - id-face (get-text-property id-start 'face)) - - (if (cond - ((eq id-face 'font-lock-type-face) - ;; The identifier got the type face so it has already been - ;; handled in `c-font-lock-declarations'. - nil) - - ((eq id-face 'font-lock-keyword-face) - (when (looking-at c-opt-<>-sexp-key) - ;; There's a special keyword before the "<" that tells - ;; that it's an angle bracket arglist. - (setq kwd-sym (c-keyword-sym (match-string 1))))) - - (t - ;; There's a normal identifier before the "<". If we're not in - ;; a declaration context then we set `c-restricted-<>-arglists' - ;; to avoid recognizing templates in function calls like "foo (a - ;; < b, c > d)". - (c-backward-syntactic-ws) - (when (and (memq (char-before) '(?\( ?,)) - (not (eq (get-text-property (1- (point)) 'c-type) - 'c-decl-arg-start))) - (setq c-restricted-<>-arglists t)) - t)) + (setq old-pos (point)) + (c-syntactic-re-search-forward "<" limit t nil t)) + (setq pos (point)) + (save-excursion + (backward-char) + (c-backward-syntactic-ws old-pos) + (if (re-search-backward + (concat "\\(\\`\\|" c-nonsymbol-key "\\)\\(" c-symbol-key"\\)\\=") + old-pos t) + (setq id-start (match-beginning 2) + id-end (match-end 2)) + (setq id-start nil id-end nil))) + + (when id-start + (goto-char id-start) + (unless (c-skip-comments-and-strings limit) + (setq kwd-sym nil + c-restricted-<>-arglists nil + id-face (get-text-property id-start 'face)) + + (if (cond + ((eq id-face 'font-lock-type-face) + ;; The identifier got the type face so it has already been + ;; handled in `c-font-lock-declarations'. + nil) - (progn - (goto-char (1- pos)) - ;; Check for comment/string both at the identifier and - ;; at the "<". - (unless (c-skip-comments-and-strings limit) - - (c-fontify-types-and-refs () - (when (c-forward-<>-arglist (c-keyword-member - kwd-sym 'c-<>-type-kwds)) - (when (and c-opt-identifier-concat-key - (not (get-text-property id-start 'face))) - (c-forward-syntactic-ws) - (cond ((looking-at c-opt-identifier-concat-key) - (c-put-font-lock-face id-start id-end - c-reference-face-name)) - ((eq (char-after) ?\()) - (t (c-put-font-lock-face id-start id-end - 'font-lock-type-face)))))) - - (goto-char pos))) - (goto-char pos)))))) + ((eq id-face 'font-lock-keyword-face) + (when (looking-at c-opt-<>-sexp-key) + ;; There's a special keyword before the "<" that tells + ;; that it's an angle bracket arglist. + (setq kwd-sym (c-keyword-sym (match-string 2))))) + + (t + ;; There's a normal identifier before the "<". If we're not in + ;; a declaration context then we set `c-restricted-<>-arglists' + ;; to avoid recognizing templates in function calls like "foo (a + ;; < b, c > d)". + (c-backward-syntactic-ws) + (when (and (memq (char-before) '(?\( ?,)) + (not (eq (get-text-property (1- (point)) 'c-type) + 'c-decl-arg-start))) + (setq c-restricted-<>-arglists t)) + t)) + + (progn + (goto-char (1- pos)) + ;; Check for comment/string both at the identifier and + ;; at the "<". + (unless (c-skip-comments-and-strings limit) + + (c-fontify-types-and-refs () + (when (c-forward-<>-arglist (c-keyword-member + kwd-sym 'c-<>-type-kwds)) + (when (and c-opt-identifier-concat-key + (not (get-text-property id-start 'face))) + (c-forward-syntactic-ws) + (cond ((looking-at c-opt-identifier-concat-key) + (c-put-font-lock-face id-start id-end + c-reference-face-name)) + ((eq (char-after) ?\()) + (t (c-put-font-lock-face id-start id-end + 'font-lock-type-face)))))) + + (goto-char pos))) + (goto-char pos))))))) nil) (defun c-font-lock-declarators (limit list types not-top diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index d6089ea295..4d1aeaa5cb 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -699,6 +699,7 @@ It's assumed to not contain any submatchers." ;; The same thing regarding Unicode identifiers applies here as to ;; `c-symbol-key'. t (concat "[" (c-lang-const c-nonsymbol-chars) "]")) +(c-lang-defvar c-nonsymbol-key (c-lang-const c-nonsymbol-key)) (c-lang-defconst c-identifier-ops "The operators that make up fully qualified identifiers. nil in commit 9022df70270243f211c54ccd66800320148b8434 Author: Alan Mackenzie Date: Mon Dec 14 19:38:52 2020 +0000 Optimise c-parse-state for large buffers with few (if any) braces. * lisp/progmodes/cc-engine (c-get-fallback-scan-pos): Search a maximum of 50,000 characters back for the two BODs. Return nil if we dont' find them. (c-parse-state-get-strategy): For strategy `forward', always use the position `good-pos' for `start-point', even when there's a change of current macro. Deal with a possible return value of nil from c-get-fallback-scan-pos (as above). (c-invalidate-state-cache-1): For `c-state-cache-good-pos', instead of sometimes using the minimum scan pos (leading to extensive scanning of the entire buffer) use a point close to `here'. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index f14ffb38cd..68dadcc272 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -3568,15 +3568,19 @@ mhtml-mode." ;; Return a start position for building `c-state-cache' from ;; scratch. This will be at the top level, 2 defuns back. (save-excursion - ;; Go back 2 bods, but ignore any bogus positions returned by - ;; beginning-of-defun (i.e. open paren in column zero). - (goto-char here) - (let ((cnt 2)) - (while (not (or (bobp) (zerop cnt))) - (c-beginning-of-defun-1) ; Pure elisp BOD. - (if (eq (char-after) ?\{) - (setq cnt (1- cnt))))) - (point))) + (save-restriction + (when (> here (* 10 c-state-cache-too-far)) + (narrow-to-region (- here (* 10 c-state-cache-too-far)) here)) + ;; Go back 2 bods, but ignore any bogus positions returned by + ;; beginning-of-defun (i.e. open paren in column zero). + (goto-char here) + (let ((cnt 2)) + (while (not (or (bobp) (zerop cnt))) + (c-beginning-of-defun-1) ; Pure elisp BOD. + (if (eq (char-after) ?\{) + (setq cnt (1- cnt))))) + (and (not (bobp)) + (point))))) (defun c-state-balance-parens-backwards (here- here+ top) ;; Return the position of the opening paren/brace/bracket before HERE- which @@ -3667,9 +3671,7 @@ mhtml-mode." how-far 0)) ((<= good-pos here) (setq strategy 'forward - start-point (if changed-macro-start - cache-pos - (max good-pos cache-pos)) + start-point (max good-pos cache-pos) how-far (- here start-point))) ((< (- good-pos here) (- here cache-pos)) ; FIXME!!! ; apply some sort of weighting. (setq strategy 'backward @@ -3688,7 +3690,8 @@ mhtml-mode." ;; (not (c-major-mode-is 'c++-mode)) (> how-far c-state-cache-too-far)) (setq BOD-pos (c-get-fallback-scan-pos here)) ; somewhat EXPENSIVE!!! - (if (< (- here BOD-pos) how-far) + (if (and BOD-pos + (< (- here BOD-pos) how-far)) (setq strategy 'BOD start-point BOD-pos))) @@ -4337,8 +4340,12 @@ mhtml-mode." (if (and dropped-cons (<= too-high-pa here)) (c-append-lower-brace-pair-to-state-cache too-high-pa here here-bol)) - (setq c-state-cache-good-pos (or (c-state-cache-after-top-paren) - (c-state-get-min-scan-pos))))) + (if (and c-state-cache-good-pos (< here c-state-cache-good-pos)) + (setq c-state-cache-good-pos + (or (save-excursion + (goto-char here) + (c-literal-start)) + here))))) ;; The brace-pair desert marker: (when (car c-state-brace-pair-desert) commit cd81739af17406cad0eb121cd979350e45cd1b92 Author: Lars Ingebrigtsen Date: Mon Dec 14 19:54:29 2020 +0100 Add some admin/emake comments diff --git a/admin/emake b/admin/emake index d794e1c417..d9aa4ea74b 100755 --- a/admin/emake +++ b/admin/emake @@ -1,5 +1,14 @@ #!/bin/bash +# This script is meant to be used as ./admin/emake, and will compile +# the Emacs tree with virtually all of the informational messages +# removed, and with errors/warnings highlighted in red. It'll give a +# quick overview to confirm that nothing has broken, for instance +# after doing a "git pull". It's not meant to be used during actual +# development, because it removes so much information that commands +# like `next-error' won't be able to jump to the source code where +# errors are. + cores=1 # Determine the number of cores. commit 5337211b9453c25ef1b35bcb33844059ea34a10a Author: Gregory Heytings Date: Mon Dec 14 19:49:39 2020 +0100 Make the emake error messages red * admin/emake: Colorize error messages. diff --git a/admin/emake b/admin/emake new file mode 100755 index 0000000000..d794e1c417 --- /dev/null +++ b/admin/emake @@ -0,0 +1,76 @@ +#!/bin/bash + +cores=1 + +# Determine the number of cores. +if [ -f /proc/cpuinfo ]; then + cores=$(($(egrep "^physical id|^cpu cores" /proc/cpuinfo |\ + awk '{ print $4; }' |\ + sed '$!N;s/\n/ /' |\ + uniq |\ + sed 's/^[0-9]*/+/'))) +fi + +make -j$cores "$@" 2>&1 | \ +sed -u 's# \.\./\.\./# # +s# \.\./# # +s#^Configuring local git # Configuring local git # +s#^Installing git hooks...# Installing git hooks...# +s#^Running # Running # +s#^Configured for # Configured for # +s#^./temacs # ./temacs # +s#^Dumping under the name# Dumping under the name# +' | \ +egrep --line-buffered -v "^make|\ +^Loading|\ +SCRAPE|\ +INFO.*Scraping.*[.]\$|\ +^Waiting for git|\ +^Finding pointers|\ +^Using load-path|\ +^Adding name|\ +^Dump mode|\ +^Dumping finger|\ +^Byte counts|\ +^Reloc counts|\ +^Pure-hashed|\ +^cp -f temacs|\ +^rm -f bootstrap|\ +^Dump complete|\ +^rm -f emacs|\ +mkdir -p etc|\ +mkdir -p info|\ +mkdir -p lisp|\ +^LC_ALL.*pdump|\ +^cp -f emacs.p|\ +GEN.*loaddefs|\ +^Reloading stale|\ +^Source file.*newer than|\ +^Directories for loaddefs|\ +^./autogen.sh|\ +^[Cc]hecking |\ +^.Read INSTALL.REPO for more|\ +^Your system has the required tools.|\ +^Building aclocal.m4|\ +^ Running 'autoreconf|\ +^You can now run './configure'|\ +^./configure|\ +^configure: creating|\ +^\"configure\" file built.|\ +^There seems to be no|\ +^config.status:|\ +^ *$|\ +^Makefile built|\ +The GNU allocators don't work|\ +^git config |\ +^'\.git/|\ +^\^\(\(|\ +^'build-aux/git-hooks\ +" | \ +while read +do + C="" + [[ "X${REPLY:0:1}" != "X " ]] && C="\033[1;31m" + [[ "X${REPLY:0:3}" == "X " ]] && C="\033[1;31m" + [[ "X$C" == "X" ]] && printf "%s\n" "$REPLY" || printf "$C%s\033[0m\n" "$REPLY" +done commit c0c6cd2d5d7af82ddfd4d8d080d0aa8d7882d293 Author: Michael Albinus Date: Mon Dec 14 19:30:01 2020 +0100 Add 'remote-file-error' for Tramp * doc/lispref/errors.texi (Standard Errors): Add 'remote-file-error'. * etc/NEWS: Mention 'remote-file-error'. * lisp/net/ange-ftp.el (ftp-error): Add error condition `remote-file-error'. * lisp/net/tramp-cmds.el (tramp-cleanup-all-connections): Do not set `tramp-locked'. * lisp/net/tramp-compat.el (remote-file-error): Define if it doesn't exist. * lisp/net/tramp-sh.el (tramp-timeout-session): Check for "locked" property. (tramp-maybe-open-connection): Simplify. * lisp/net/tramp.el (tramp-locked, tramp-locker): Remove them. (tramp-file-name-handler): Do not set them. (with-tramp-locked-connection): New defmacro. (tramp-accept-process-output, tramp-send-string): Use it. * src/fileio.c (Qremote_file_error): New error symbol. * test/lisp/net/tramp-tests.el (tramp-test43-asynchronous-requests): Adapt test. Remove :unstable tag. diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi index cd8694be8a..ff9b3e5712 100644 --- a/doc/lispref/errors.texi +++ b/doc/lispref/errors.texi @@ -129,9 +129,18 @@ This is a subcategory of @code{file-error}. @xref{Modification Time}. This is a subcategory of @code{file-error}. It happens, when a file could not be watched for changes. @xref{File Notifications}. +@item remote-file-error +This is a subcategory of @code{file-error}, which results from +problems in accessing a remote file. @xref{Remote Files,,, emacs, The +GNU Emacs Manual}. Often, this error appears when timers, process +filters, process sentinels or special events in general try to access +a remote file, and collide with another remote file operation. In +general it is a good idea to write a bug report. @xref{Reporting +Bugs,,, emacs, The GNU Emacs Manual}. + @c net/ange-ftp.el @item ftp-error -This is a subcategory of @code{file-error}, which results from +This is a subcategory of @code{remote-file-error}, which results from problems in accessing a remote file using ftp. @xref{Remote Files,,, emacs, The GNU Emacs Manual}. diff --git a/etc/NEWS b/etc/NEWS index 05274a2d6c..87463372d5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -89,7 +89,7 @@ useful on systems such as FreeBSD which ships only with "etc/termcap". This is controlled by the new variable 'scroll-minibuffer-conservatively'. In addition, there is a new variable -`redisplay-adhoc-scroll-in-resize-mini-windows` to disable the +'redisplay-adhoc-scroll-in-resize-mini-windows' to disable the ad-hoc auto-scrolling when resizing minibuffer windows. It has been found that its heuristic can be counter productive in some corner cases, tho the cure may be worse than the disease. This said, the @@ -303,8 +303,8 @@ the buffer cycles the whole buffer between "only top-level headings", * Changes in Specialized Modes and Packages in Emacs 28.1 -** Loading dunnet.el in batch mode doesn't start the game any more -Instead you need to do 'emacs -f dun-batch' to start the game in +** Loading dunnet.el in batch mode doesn't start the game any more. +Instead you need to do "emacs -f dun-batch" to start the game in batch mode. ** Emacs Server @@ -523,21 +523,20 @@ tags to be considered as well. +++ *** New user option 'gnus-registry-register-all'. - If non-nil (the default), create registry entries for all messages. If nil, don't automatically create entries, they must be created manually. +++ -*** New user options to customise the summary line specs %[ and %]. +*** New user options to customise the summary line specs "%[" and "%]". Four new options introduced in customisation group 'gnus-summary-format'. These are 'gnus-sum-opening-bracket', 'gnus-sum-closing-bracket', 'gnus-sum-opening-bracket-adopted', and -'gnus-sum-closing-bracket-adopted'. Their default values are '[', ']', -'<', '>' respectively. These variables control the appearance of '%[' -and '%]' specs in the summary line format. '%[' will normally display +'gnus-sum-closing-bracket-adopted'. Their default values are "[", "]", +"<", ">" respectively. These options control the appearance of "%[" +and "%]" specs in the summary line format. "%[" will normally display the value of 'gnus-sum-opening-bracket', but can also be -'gnus-sum-opening-bracket-adopted' for the adopted articles. '%]' will +'gnus-sum-opening-bracket-adopted' for the adopted articles. "%]" will normally display the value of 'gnus-sum-closing-bracket', but can also be 'gnus-sum-closing-bracket-adopted' for the adopted articles. @@ -1130,13 +1129,13 @@ If 'shr-width' is non-nil, it overrides this variable. ** Images --- -** Can explicitly specify base_uri for svg images. +*** You can explicitly specify base_uri for svg images. ':base-uri' image property can be used to explicitly specify base_uri -for embedded images into svg. ':base-uri' is supported for both file +for embedded images into svg. ':base-uri' is supported for both file and data svg images. +++ -** 'svg-embed-base-uri-image' added to embed images +*** 'svg-embed-base-uri-image' added to embed images. 'svg-embed-base-uri-image' can be used to embed images located relatively to 'file-name-directory' of the ':base-uri' svg image property. This works much faster then 'svg-embed'. @@ -1256,8 +1255,8 @@ project's root directory, respectively. So typing 'C-u RET' in the "*xref*" buffer quits its window before navigating to the selected location. -*** New options xref-search-program and xref-search-program-alist. -So far Grep and ripgrep are supported. ripgrep seems to offer better +*** New user options 'xref-search-program' and 'xref-search-program-alist'. +So far 'grep' and 'ripgrep' are supported. 'ripgrep' seems to offer better performance in certain cases, in particular for case-insensitive searches. @@ -1442,9 +1441,8 @@ that makes it a valid button. ** Miscellaneous +++ - *** New variable 'current-minibuffer-command'. -This is like 'this-command', but is bound recursively when entering +This is like 'this-command', but it is bound recursively when entering the minibuffer. +++ @@ -1763,14 +1761,12 @@ used instead. * New Modes and Packages in Emacs 28.1 ** Lisp Data mode - The new command 'lisp-data-mode' enables a major mode for buffers composed of Lisp symbolic expressions that do not form a computer program. The ".dir-locals.el" file is automatically set to use this mode, as are other data files produced by Emacs. ** hierarchy.el - It's a library to create, query, navigate and display hierarchy structures. ** New themes 'modus-vivendi' and 'modus-operandi'. @@ -1781,13 +1777,12 @@ Consult the Modus Themes Info manual for more information on the user options they provide. ** Dictionary mode - -This is a mode for searching a RFC 2229 dictionary -server. 'dictionary' opens a buffer for starting -operations. 'dictionary-search' performs a lookup for a word. It also -supports a 'dictionary-tooltip-mode' which performs a lookup of the -word under the mouse in 'dictionary-tooltip-dictionary' (which must be -customized first). +This is a mode for searching a RFC 2229 dictionary server. +'dictionary' opens a buffer for starting operations. +'dictionary-search' performs a lookup for a word. It also supports a +'dictionary-tooltip-mode' which performs a lookup of the word under +the mouse in 'dictionary-tooltip-dictionary' (which must be customized +first). * Incompatible Editing Changes in Emacs 28.1 @@ -1939,7 +1934,7 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el. * Lisp Changes in Emacs 28.1 -** New function `garbage-collect-maybe` to trigger GC early +** New function 'garbage-collect-maybe' to trigger GC early. --- ** 'defvar' detects the error of defining a variable currently lexically bound. @@ -2164,6 +2159,20 @@ and 'play-sound-file'. If this variable is non-nil, character syntax is used for printing numbers when this makes sense, such as '?A' for 65. +** New error 'remote-file-error', a subcategory of 'file-error'. +It is signaled if a remote file operation fails due to internal +reasons, and could block Emacs. It does not replace 'file-error' +signals for the usual cases. Timers, process filters and process +functions, which run remote file operations, shall protect themselves +against this error. + +If such an error occurs, please report this as bug via 'M-x report-emacs-bug'. +Until it is solved you could ignore such errors by performing + + (setq debug-ignored-errors (cons 'remote-file-error debug-ignored-errors)) + +** The error 'ftp-error' belongs also to category 'remote-file-error'. + * Changes in Emacs 28.1 on Non-Free Operating Systems diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index c627e1a088..1922adb548 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -1080,7 +1080,7 @@ All HOST values should be in lower case.") (defvar ange-ftp-trample-marker) ;; New error symbols. -(define-error 'ftp-error nil 'file-error) ;"FTP error" +(define-error 'ftp-error nil '(remote-file-error file-error)) ;"FTP error" ;;; ------------------------------------------------------------ ;;; Enhanced message support. diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 622116d9f9..9b6250430a 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -159,9 +159,6 @@ When called interactively, a Tramp connection has to be selected." This includes password cache, file cache, connection cache, buffers." (interactive) - ;; Unlock Tramp. - (setq tramp-locked nil) - ;; Flush password cache. (password-reset) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index b44eabcfa8..4c8d37d602 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -348,6 +348,11 @@ A nil value for either argument stands for the current time." (lambda (fromstring tostring instring) (replace-regexp-in-string (regexp-quote fromstring) tostring instring)))) +;; Error symbol `remote-file-error' is defined in Emacs 28.1. We use +;; an adapted error message in order to see that compatible symbol. +(unless (get 'remote-file-error 'error-conditions) + (define-error 'remote-file-error "Remote file error (compat)" 'file-error)) + (add-hook 'tramp-unload-hook (lambda () (unload-feature 'tramp-loaddefs 'force) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 34be4fcba9..e9814cdadb 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2944,7 +2944,8 @@ implementation will be used." (mapconcat #'tramp-shell-quote-argument uenv " ")) "") - (if heredoc (format "<<'%s'" tramp-end-of-heredoc) "") + (if heredoc + (format "<<'%s'" tramp-end-of-heredoc) "") (if tmpstderr (format "2>'%s'" tmpstderr) "") (mapconcat #'tramp-shell-quote-argument env " ") (if heredoc @@ -4914,7 +4915,8 @@ Goes through the list `tramp-inline-compress-commands'." (defun tramp-timeout-session (vec) "Close the connection VEC after a session timeout. If there is just some editing, retry it after 5 seconds." - (if (and tramp-locked tramp-locker + (if (and (tramp-get-connection-property + (tramp-get-connection-process vec) "locked" nil) (tramp-file-name-equal-p vec (car tramp-current-connection))) (progn (tramp-message @@ -4958,10 +4960,9 @@ connection if a previous connection has died for some reason." (when (and (time-less-p 60 (time-since (tramp-get-connection-property p "last-cmd-time" 0))) - (process-live-p p)) - (tramp-send-command vec "echo are you awake" t t) - (unless (and (process-live-p p) - (tramp-wait-for-output p 10)) + (process-live-p p) + (tramp-get-connection-property p "connected" nil)) + (unless (tramp-send-command-and-check vec "echo are you awake") ;; The error will be caught locally. (tramp-error vec 'file-error "Awake did fail"))) (file-error diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 6750a7ff4c..70bf1eee26 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2349,33 +2349,6 @@ Must be handled by the callers." res (cdr elt)))) res))) -;; In Emacs, there is some concurrency due to timers. If a timer -;; interrupts Tramp and wishes to use the same connection buffer as -;; the "main" Emacs, then garbage might occur in the connection -;; buffer. Therefore, we need to make sure that a timer does not use -;; the same connection buffer as the "main" Emacs. We implement a -;; cheap global lock, instead of locking each connection buffer -;; separately. The global lock is based on two variables, -;; `tramp-locked' and `tramp-locker'. `tramp-locked' is set to true -;; (with setq) to indicate a lock. But Tramp also calls itself during -;; processing of a single file operation, so we need to allow -;; recursive calls. That's where the `tramp-locker' variable comes in -;; -- it is let-bound to t during the execution of the current -;; handler. So if `tramp-locked' is t and `tramp-locker' is also t, -;; then we should just proceed because we have been called -;; recursively. But if `tramp-locker' is nil, then we are a timer -;; interrupting the "main" Emacs, and then we signal an error. - -(defvar tramp-locked nil - "If non-nil, then Tramp is currently busy. -Together with `tramp-locker', this implements a locking mechanism -preventing reentrant calls of Tramp.") - -(defvar tramp-locker nil - "If non-nil, then a caller has locked Tramp. -Together with `tramp-locked', this implements a locking mechanism -preventing reentrant calls of Tramp.") - ;; Main function. (defun tramp-file-name-handler (operation &rest args) "Invoke Tramp file name handler for OPERATION and ARGS. @@ -2429,17 +2402,7 @@ Fall back to normal file name handler if no Tramp file name handler exists." (setq result (catch 'non-essential (catch 'suppress - (when (and tramp-locked (not tramp-locker)) - (setq tramp-locked nil) - (tramp-error - v 'file-error - "Forbidden reentrant call of Tramp")) - (let ((tl tramp-locked)) - (setq tramp-locked t) - (unwind-protect - (let ((tramp-locker t)) - (apply foreign operation args)) - (setq tramp-locked tl)))))) + (apply foreign operation args)))) ;; (tramp-message ;; v 4 "Running `%s'...`%s'" (cons operation args) result) (cond @@ -4499,6 +4462,32 @@ performed successfully. Any other value means an error." ;;; Utility functions: +;; In Emacs, there is some concurrency due to timers. If a timer +;; interrupts Tramp and wishes to use the same connection buffer as +;; the "main" Emacs, then garbage might occur in the connection +;; buffer. Therefore, we need to make sure that a timer does not use +;; the same connection buffer as the "main" Emacs. We lock each +;; connection process separately by a connection property. + +(defmacro with-tramp-locked-connection (proc &rest body) + "Lock PROC for other communication, and run BODY. +Mostly useful to protect BODY from being interrupted by timers." + (declare (indent 1) (debug t)) + `(if (tramp-get-connection-property ,proc "locked" nil) + ;; Be kind for older Emacsen. + (if (member 'remote-file-error debug-ignored-errors) + (throw 'non-essential 'non-essential) + (tramp-error + ,proc 'remote-file-error "Forbidden reentrant call of Tramp")) + (unwind-protect + (progn + (tramp-set-connection-property ,proc "locked" t) + ,@body) + (tramp-flush-connection-property ,proc "locked")))) + +(font-lock-add-keywords + 'emacs-lisp-mode '("\\")) + (defun tramp-accept-process-output (proc &optional timeout) "Like `accept-process-output' for Tramp processes. This is needed in order to hide `last-coding-system-used', which is set @@ -4508,15 +4497,17 @@ If the user quits via `C-g', it is propagated up to `tramp-file-name-handler'." (let ((inhibit-read-only t) last-coding-system-used result) - ;; JUST-THIS-ONE is set due to Bug#12145. `with-local-quit' - ;; returns t in order to report success. - (if (with-local-quit - (setq result (accept-process-output proc timeout nil t)) t) - (tramp-message - proc 10 "%s %s %s %s\n%s" - proc timeout (process-status proc) result (buffer-string)) - ;; Propagate quit. - (keyboard-quit)) + ;; This must be protected by the "locked" property. + (with-tramp-locked-connection proc + ;; JUST-THIS-ONE is set due to Bug#12145. `with-local-quit' + ;; returns t in order to report success. + (if (with-local-quit + (setq result (accept-process-output proc timeout nil t)) t) + (tramp-message + proc 10 "%s %s %s %s\n%s" + proc timeout (process-status proc) result (buffer-string)) + ;; Propagate quit. + (keyboard-quit))) result))) (defun tramp-search-regexp (regexp) @@ -4633,19 +4624,21 @@ the remote host use line-endings as defined in the variable (unless (or (string-empty-p string) (string-equal (substring string -1) tramp-rsh-end-of-line)) (setq string (concat string tramp-rsh-end-of-line))) - ;; Send the string. - (with-local-quit - (if (and chunksize (not (zerop chunksize))) - (let ((pos 0) - (end (length string))) - (while (< pos end) - (tramp-message - vec 10 "Sending chunk from %s to %s" - pos (min (+ pos chunksize) end)) - (process-send-string - p (substring string pos (min (+ pos chunksize) end))) - (setq pos (+ pos chunksize)))) - (process-send-string p string)))))) + ;; This must be protected by the "locked" property. + (with-tramp-locked-connection p + ;; Send the string. + (with-local-quit + (if (and chunksize (not (zerop chunksize))) + (let ((pos 0) + (end (length string))) + (while (< pos end) + (tramp-message + vec 10 "Sending chunk from %s to %s" + pos (min (+ pos chunksize) end)) + (process-send-string + p (substring string pos (min (+ pos chunksize) end))) + (setq pos (+ pos chunksize)))) + (process-send-string p string))))))) (defun tramp-process-sentinel (proc event) "Flush file caches and remove shell prompt." diff --git a/src/fileio.c b/src/fileio.c index 702c143828..c97f4daf20 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -6259,6 +6259,7 @@ syms_of_fileio (void) DEFSYM (Qfile_date_error, "file-date-error"); DEFSYM (Qfile_missing, "file-missing"); DEFSYM (Qfile_notify_error, "file-notify-error"); + DEFSYM (Qremote_file_error, "remote-file-error"); DEFSYM (Qexcl, "excl"); DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system, @@ -6320,6 +6321,11 @@ behaves as if file names were encoded in `utf-8'. */); Fput (Qfile_notify_error, Qerror_message, build_pure_c_string ("File notification error")); + Fput (Qremote_file_error, Qerror_conditions, + Fpurecopy (list3 (Qremote_file_error, Qfile_error, Qerror))); + Fput (Qremote_file_error, Qerror_message, + build_pure_c_string ("Remote file error")); + DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist, doc: /* Alist of elements (REGEXP . HANDLER) for file names handled specially. If a file name matches REGEXP, all I/O on that file is done by calling diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 819a3dfecf..0a5931d689 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4817,6 +4817,7 @@ INPUT, if non-nil, is a string sent to the process." ;; this test cannot run properly. :tags '(:expensive-test :unstable) (skip-unless (tramp--test-enabled)) + (skip-unless nil) (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) (skip-unless (not (tramp--test-crypt-p))) ;; Prior Emacs 27, `shell-command-dont-erase-buffer' wasn't working properly. @@ -6236,15 +6237,14 @@ This is needed in timer functions as well as process filters and sentinels." "Check parallel asynchronous requests. Such requests could arrive from timers, process filters and process sentinels. They shall not disturb each other." - ;; The test fails from time to time, w/o a reproducible pattern. So - ;; we mark it as unstable. - :tags '(:expensive-test :unstable) + :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) ;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for ;; remote processes in Emacs. That doesn't work for tramp-adb.el. (skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p)) (tramp--test-sh-p))) (skip-unless (not (tramp--test-crypt-p))) + (skip-unless (not (tramp--test-docker-p))) (with-timeout (tramp--test-asynchronous-requests-timeout (tramp--test-timeout-handler)) @@ -6283,10 +6283,10 @@ process sentinels. They shall not disturb each other." ((getenv "EMACS_HYDRA_CI") 10) (t 1))) ;; We must distinguish due to performance reasons. - ;; (timer-operation - ;; (cond - ;; ((tramp--test-mock-p) #'vc-registered) - ;; (t #'file-attributes))) + (timer-operation + (cond + ((tramp--test-mock-p) #'vc-registered) + (t #'file-attributes))) ;; This is when all timers start. We check inside the ;; timer function, that we don't exceed timeout. (timer-start (current-time)) @@ -6314,10 +6314,15 @@ process sentinels. They shall not disturb each other." (default-directory tmp-name) (file (buffer-name - (nth (random (length buffers)) buffers)))) + (nth (random (length buffers)) buffers))) + ;; A remote operation in a timer could + ;; confuse Tramp heavily. So we ignore this + ;; error here. + (debug-ignored-errors + (cons 'remote-file-error debug-ignored-errors))) (tramp--test-message "Start timer %s %s" file (current-time-string)) - ;; (funcall timer-operation file) + (funcall timer-operation file) (tramp--test-message "Stop timer %s %s" file (current-time-string)) ;; Adjust timer if it takes too much time. @@ -6618,14 +6623,12 @@ If INTERACTIVE is non-nil, the tests are run interactively." ;; * Work on skipped tests. Make a comment, when it is impossible. ;; * Revisit expensive tests, once problems in `tramp-error' are solved. -;; * Fix `tramp-test05-expand-file-name-relative' in `expand-file-name'. ;; * Fix `tramp-test06-directory-file-name' for `ftp'. ;; * Investigate, why `tramp-test11-copy-file' and `tramp-test12-rename-file' ;; do not work properly for `nextcloud'. ;; * Implement `tramp-test31-interrupt-process' for `adb' and for ;; direct async processes. -;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'. A remote -;; file name operation cannot run in the timer. Remove `:unstable' tag? +;; * Fix `tramp-test44-threads'. (provide 'tramp-tests) commit 47a854bf24c8a36bf1e8ac32c8b5c9ebcba1d90a Author: Eli Zaretskii Date: Mon Dec 14 20:23:24 2020 +0200 Improve accuracy of scrolling commands * src/xdisp.c (move_it_vertically_backward): Don't rely on line_bottom_y for accurate calculation of the next screen line's Y coordinate: it doesn't work when the current screen line was not yet traversed. Instead, record the previous Y coordinate and reseat there if overshoot is detected. * src/window.c (window_scroll_pixel_based): Calculate the new window-start point more accurately when screen lines have uneven height. (Bug#8355) diff --git a/src/window.c b/src/window.c index 8e75e460b2..4eab786958 100644 --- a/src/window.c +++ b/src/window.c @@ -5686,27 +5686,20 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) we would end up at the start of the line ending at ZV. */ if (dy <= 0) { - goal_y = it.current_y - dy; + goal_y = it.current_y + dy; move_it_vertically_backward (&it, -dy); - /* Extra precision for people who want us to preserve the - screen position of the cursor: effectively round DY to the - nearest screen line, instead of rounding to zero; the latter - causes point to move by one line after C-v followed by M-v, - if the buffer has lines of different height. */ - if (!NILP (Vscroll_preserve_screen_position) - && it.current_y - goal_y > 0.5 * flh) + /* move_it_vertically_backward above always overshoots if DY + cannot be reached exactly, i.e. if it falls in the middle + of a screen line. But if that screen line is large + (e.g., a tall image), it might make more sense to + undershoot instead. */ + if (goal_y - it.current_y > 0.5 * flh) { it_data = bidi_shelve_cache (); - struct it it2 = it; - - move_it_by_lines (&it, -1); - if (it.current_y < goal_y - 0.5 * flh) - { - it = it2; - bidi_unshelve_cache (it_data, false); - } - else - bidi_unshelve_cache (it_data, true); + struct it it1 = it; + if (line_bottom_y (&it1) - goal_y < goal_y - it.current_y) + move_it_by_lines (&it, 1); + bidi_unshelve_cache (it_data, true); } /* Ensure we actually do move, e.g. in case we are currently looking at an image that is taller that the window height. */ @@ -5718,8 +5711,11 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) { goal_y = it.current_y + dy; move_it_to (&it, ZV, -1, goal_y, -1, MOVE_TO_POS | MOVE_TO_Y); - /* See the comment above, for the reasons of this - extra-precision. */ + /* Extra precision for people who want us to preserve the + screen position of the cursor: effectively round DY to the + nearest screen line, instead of rounding to zero; the latter + causes point to move by one line after C-v followed by M-v, + if the buffer has lines of different height. */ if (!NILP (Vscroll_preserve_screen_position) && goal_y - it.current_y > 0.5 * flh) { diff --git a/src/xdisp.c b/src/xdisp.c index 96dd4fade2..699183f3f5 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -10301,11 +10301,22 @@ move_it_vertically_backward (struct it *it, int dy) move_it_vertically (it, target_y - it->current_y); else { + struct text_pos last_pos; + int last_y, last_vpos; do { + last_pos = it->current.pos; + last_y = it->current_y; + last_vpos = it->vpos; move_it_by_lines (it, 1); } - while (target_y >= line_bottom_y (it) && IT_CHARPOS (*it) < ZV); + while (target_y > it->current_y && IT_CHARPOS (*it) < ZV); + if (it->current_y > target_y) + { + reseat (it, last_pos, true); + it->current_y = last_y; + it->vpos = last_vpos; + } } } } commit 2f1441cbe3ccd49037e2464485658f7f20f3d804 Author: Stefan Kangas Date: Mon Dec 14 19:21:28 2020 +0100 Make XEmacs entry in the FAQ more contemporary * doc/misc/efaq.texi (Difference between Emacs and XEmacs): Make XEmacs entry in the FAQ more contemporary. Remove part about re-using XEmacs code; this is not likely to be relevant these days and in any case is not a frequently asked question. (Bug#45235) diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 06a17d9c46..83c0a19d39 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -3390,7 +3390,7 @@ problem (@pxref{Reporting bugs}). * Packages that do not come with Emacs:: * Spell-checkers:: * Current GNU distributions:: -* Difference between Emacs and XEmacs:: +* What was XEmacs?:: * Emacs for minimalists:: * Emacs for MS-DOS:: * Emacs for MS-Windows:: @@ -3526,35 +3526,21 @@ A list of sites mirroring @samp{ftp.gnu.org} can be found at @uref{https://www.gnu.org/prep/ftp} -@node Difference between Emacs and XEmacs -@section What is the difference between Emacs and XEmacs (formerly Lucid Emacs)? +@node What was XEmacs? +@section What was XEmacs? @cindex XEmacs -@cindex Difference Emacs and XEmacs -@cindex Lucid Emacs -@cindex Epoch XEmacs was a branch version of Emacs that is no longer actively -developed. XEmacs was first called Lucid Emacs, and was initially -derived from a prerelease version of Emacs 19. In this FAQ, we use -the name ``Emacs'' only for the official version. - -XEmacs last released a new version on January 30, 2009, and it lacks -many important features that exists in Emacs. In the past, it was not -uncommon for Emacs packages to include code for compatibility with -XEmacs. Nowadays, although some packages still maintain such -compatibility code, several of the more popular built-in and third -party packages have either stopped supporting XEmacs or were developed -exclusively for Emacs. +developed. XEmacs last released a new version on January 30, 2009, +and it lacks many important features that exist in Emacs. Since its +development has stopped, we do not expect to see any new releases. -Some XEmacs code has been contributed to Emacs, and we would like to -use other parts, but the earlier XEmacs maintainers did not always -keep track of the authors of contributed code, which makes it -impossible for the FSF to get copyright papers signed for that code. -(The FSF requires these papers for all the code included in the Emacs -release, aside from generic C support packages that retain their -separate identity and are not integrated into the code of Emacs -proper.) +In the past, it was not uncommon for Emacs packages to include code +for compatibility with XEmacs. Nowadays, most built-in and third party +packages have either stopped supporting XEmacs or were developed +exclusively for Emacs. +XEmacs was initially derived from a prerelease version of Emacs 19. If you want to talk about these two versions and distinguish them, please call them ``Emacs'' and ``XEmacs.'' To contrast ``XEmacs'' with ``GNU Emacs'' would be misleading, since XEmacs too has its commit afee776594fc7df881106fab5188f3dd40a3f8b8 Author: Eric Abrahamsen Date: Thu Dec 10 19:52:00 2020 -0800 Fix logic of gnus-search-imap-handle-date * lisp/gnus/gnus-search.el (gnus-search-imap-handle-date): Just rewrite this whole ridiculous function. diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 0e67fac002..829e0fa3ad 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -1252,44 +1252,41 @@ means (usually the \"mark\" keyword)." (gnus-search-imap-handle-string engine (cdr expr)))))))))) (cl-defmethod gnus-search-imap-handle-date ((_engine gnus-search-imap) - (date list)) + (date list)) "Turn DATE into a date string recognizable by IMAP. While other search engines can interpret partially-qualified dates such as a plain \"January\", IMAP requires an absolute date. DATE is a list of (dd mm yyyy), any element of which could be -nil. Massage those numbers into the most recent past occurrence -of whichever date elements are present." - (let ((now (decode-time (current-time)))) - ;; Set nil values to 1, current-month, current-year, or else 1, 1, - ;; current-year, depending on what we think the user meant. - (unless (seq-elt date 1) - (setf (seq-elt date 1) - (if (seq-elt date 0) - (seq-elt now 4) - 1))) - (unless (seq-elt date 0) - (setf (seq-elt date 0) 1)) - (unless (seq-elt date 2) - (setf (seq-elt date 2) - (seq-elt now 5))) - ;; Fiddle with the date until it's in the past. There - ;; must be a way to combine all these steps. - (unless (< (seq-elt date 2) - (seq-elt now 5)) - (when (< (seq-elt now 3) - (seq-elt date 0)) - (cl-decf (seq-elt date 1))) - (cond ((zerop (seq-elt date 1)) - (setf (seq-elt date 1) 1) - (cl-decf (seq-elt date 2))) - ((< (seq-elt now 4) - (seq-elt date 1)) - (cl-decf (seq-elt date 2)))))) - (format-time-string "%e-%b-%Y" (apply #'encode-time - (append '(0 0 0) - date)))) +nil (except that (dd nil yyyy) is not allowed). Massage those +numbers into the most recent past occurrence of whichever date +elements are present." + (pcase-let ((`(,nday ,nmonth ,nyear) + (seq-subseq (decode-time (current-time)) + 3 6)) + (`(,dday ,dmonth ,dyear) date)) + (unless (and dday dmonth dyear) + (unless dday (setq dday 1)) + (if dyear + ;; If we have a year, then leave everything else as is or set + ;; to 1. + (setq dmonth (or dmonth 1)) + (if dmonth + (setq dyear + (if (or (> dmonth nmonth) + (and (= dmonth nmonth) + (> dday nday))) + ;; If our day/month combo is ahead of "now", + ;; move the year back. + (1- nyear) + nyear)) + (setq dmonth 1)))) + (format-time-string + "%e-%b-%Y" + (apply #'encode-time + (append '(0 0 0) + (list dday dmonth dyear)))))) (cl-defmethod gnus-search-imap-handle-string ((engine gnus-search-imap) (str string)) commit b857ea24f7bc5288faa920e6c3174cf1ee958b70 Author: Stefan Kangas Date: Mon Dec 14 18:08:20 2020 +0100 * lisp/play/5x5.el: Fix typo. Remove redundant :group args. diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el index 3d4843a39c..5ab1493c7a 100644 --- a/lisp/play/5x5.el +++ b/lisp/play/5x5.el @@ -31,7 +31,7 @@ ;; o The code for updating the grid needs to be re-done. At the moment it ;; simply re-draws the grid every time a move is made. ;; -;; o Look into tarting up the display with color. gamegrid.el looks +;; o Look into starting up the display with color. gamegrid.el looks ;; interesting, perhaps that is the way to go? ;;; Thanks: @@ -47,8 +47,6 @@ ;;; Code: -;; Things we need. - (eval-when-compile (require 'cl-lib)) ;; Customize options. @@ -60,33 +58,27 @@ (defcustom 5x5-grid-size 5 "Size of the playing area." - :type 'integer - :group '5x5) + :type 'integer) (defcustom 5x5-x-scale 4 "X scaling factor for drawing the grid." - :type 'integer - :group '5x5) + :type 'integer) (defcustom 5x5-y-scale 3 "Y scaling factor for drawing the grid." - :type 'integer - :group '5x5) + :type 'integer) (defcustom 5x5-animate-delay .01 "Delay in seconds when animating a solution crack." - :type 'number - :group '5x5) + :type 'number) (defcustom 5x5-hassle-me t "Should 5x5 ask you when you want to do a destructive operation?" - :type 'boolean - :group '5x5) + :type 'boolean) (defcustom 5x5-mode-hook nil "Hook run on starting 5x5." - :type 'hook - :group '5x5) + :type 'hook) ;; Non-customize variables. commit e5348f125ff03ac70713e5b227f9e51f759a587b Author: Tim Ruffing Date: Mon Dec 14 17:59:58 2020 +0100 * etc/emacs.service: * etc/emacs.service (ExecStart): Make Emacs exit from systemd work better (bug#45181). The problem here is the exit code 15, which emacs will return *only* if it has received SIGTERM. I believe what's happening here is that emacsclient will call kill-emacs but not wait until the emacs server has properly shut down. However, it's supposed to wait for the shutdown as an "ExecStop" command according to "man systemd.service". So since the process is still alive when emacsclient comes back, systemd will still issue SIGTERM, making emacs return 15 (maybe after calling kill- emacs again?!). Copyright-paperwork-exempt: yes diff --git a/etc/emacs.service b/etc/emacs.service index c99c6779f5..809c49cdbc 100644 --- a/etc/emacs.service +++ b/etc/emacs.service @@ -9,7 +9,11 @@ Documentation=info:emacs man:emacs(1) https://gnu.org/software/emacs/ [Service] Type=notify ExecStart=emacs --fg-daemon -ExecStop=emacsclient --eval "(kill-emacs)" + +# Emacs will exit with status 15 after having received SIGTERM, which +# is the default "KillSignal" value systemd uses to stop services. +SuccessExitStatus=15 + # The location of the SSH auth socket varies by distribution, and some # set it from PAM, so don't override by default. # Environment=SSH_AUTH_SOCK=%t/keyring/ssh commit b63cb95ad441a47afcf6c7848e6583b89b0e6755 Author: Robert Thorpe Date: Mon Dec 14 17:51:25 2020 +0100 Mention how to handle user names with @ in rmail * doc/emacs/rmail.texi (Remote Mailboxes): Mention how to work around the problem with user names like foo@example.com (bug#16946). Copyright-paperwork-exempt: yes diff --git a/doc/emacs/rmail.texi b/doc/emacs/rmail.texi index 467c526986..0c47812449 100644 --- a/doc/emacs/rmail.texi +++ b/doc/emacs/rmail.texi @@ -1591,6 +1591,14 @@ value is used. Otherwise, Rmail will ask you for the password to use. @end enumerate +On some mail servers the usernames include domain information, which +can mean they contain the @samp{@@} character. The inbox specifier +string uses @samp{@@} to signal the start of the mailserver name. +This creates confusion for movemail. If your username contains +@samp{@@} and you're using Mailutils @command{movemail} then you can +fix this: Replace @code{@@} in the user name with its @acronym{URL} +encoding @samp{%40}. + @vindex rmail-movemail-flags If you need to pass additional command-line flags to @command{movemail}, set the variable @code{rmail-movemail-flags} a list of the flags you commit 0dd8d53344a822842660d2ac75108f40ba9ff0f4 Author: Daniel Martín Date: Mon Dec 14 17:16:00 2020 +0100 Make goto-char offer the number at point as default * lisp/subr.el (read-natnum-interactive): New function to read natural numbers for interactive functions. * src/editfns.c (Fgoto_char): Call read-natnum-interactive from the interactive definition of goto-char to offer the number at point as default. Also expand the docstring to document this new interactive behavior. * doc/emacs/basic.texi (Moving Point): Expand the Emacs manual to document this new behavior. * etc/NEWS: And announce it (bug#45199). diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index cd1ffbebd7..77c8054746 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -310,7 +310,10 @@ Scroll one screen backward, and move point onscreen if necessary @kindex M-g c @findex goto-char Read a number @var{n} and move point to buffer position @var{n}. -Position 1 is the beginning of the buffer. +Position 1 is the beginning of the buffer. If point is on or just +after a number in the buffer, that is the default for @var{n}. Just +type @key{RET} in the minibuffer to use it. You can also specify +@var{n} by giving @kbd{M-g c} a numeric prefix argument. @item M-g M-g @itemx M-g g diff --git a/etc/NEWS b/etc/NEWS index a5e2c9cf26..05274a2d6c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -257,6 +257,10 @@ When 'widen-automatically' is non-nil, 'goto-line' widens the narrowed buffer to be able to move point to the inaccessible portion. 'goto-line-relative' is bound to 'C-x n g'. ++++ +** When called interactively, 'goto-char' now offers the number at +point as default. + +++ ** When 'suggest-key-bindings' is non-nil, the completion list of 'M-x' shows equivalent key bindings for all commands that have them. diff --git a/lisp/subr.el b/lisp/subr.el index ed235ee1f7..77c19c5bbf 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2820,6 +2820,15 @@ There is no need to explicitly add `help-char' to CHARS; (message "%s%s" prompt (char-to-string char)) char)) +(defun goto-char--read-natnum-interactive (prompt) + "Get a natural number argument, optionally prompting with PROMPT. +If there is a natural number at point, use it as default." + (if (and current-prefix-arg (not (consp current-prefix-arg))) + (list (prefix-numeric-value current-prefix-arg)) + (let* ((number (number-at-point)) + (default (and (natnump number) number))) + (list (read-number prompt default))))) + ;; Behind display-popup-menus-p test. (declare-function x-popup-dialog "menu.c" (position contents &optional header)) diff --git a/src/editfns.c b/src/editfns.c index 4104edd77f..e4c4141ef5 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -188,11 +188,16 @@ DEFUN ("point-marker", Fpoint_marker, Spoint_marker, 0, 0, 0, return build_marker (current_buffer, PT, PT_BYTE); } -DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1, "NGoto char: ", +DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1, + "(goto-char--read-natnum-interactive \"Go to char: \")", doc: /* Set point to POSITION, a number or marker. Beginning of buffer is position (point-min), end is (point-max). -The return value is POSITION. */) +The return value is POSITION. + +If called interactively, a numeric prefix argument specifies +POSITION; without a numeric prefix argument, read POSITION from the +minibuffer. The default value is the number at point (if any). */) (register Lisp_Object position) { if (MARKERP (position)) commit 10bc4eac5bb2e7e4b520628286a52f0508332119 Author: Lars Ingebrigtsen Date: Mon Dec 14 17:07:41 2020 +0100 Tool bar documentation clarification: Mention forcing updates * doc/lispref/keymaps.texi (Tool Bar): Document that flipping the status of a tool bar item doesn't necessarily update the visuals (bug#42957). diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 6635f50960..9daeb2c77f 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -2812,6 +2812,11 @@ the shift modifier: @xref{Function Keys}, for more information about how to add modifiers to function keys. +If you have functions that change whether a tool bar item is enabled +or not, this status is not necessarily updated visually immediately. +To force recalculation of the tool bar, call +@code{force-mode-line-update} (@pxref{Mode Line Format}). + @node Modifying Menus @subsection Modifying Menus @cindex menu modification commit 8b3de06347dfcb4afab93f17f32297fe721b363b Author: Tomas Nordin Date: Mon Dec 14 16:58:07 2020 +0100 Fix narrow-to-defun in python-mode * lisp/progmodes/python.el (python-nav--beginning-of-defun): Make narrow-to-defun work better in classes (bug#40563). Copyright-paperwork-exempt: yes diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index d75944a702..d58b32f3c3 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1404,7 +1404,7 @@ With positive ARG search backwards, else search forwards." (line-beg-pos (line-beginning-position)) (line-content-start (+ line-beg-pos (current-indentation))) (pos (point-marker)) - (beg-indentation + (body-indentation (and (> arg 0) (save-excursion (while (and @@ -1415,9 +1415,16 @@ With positive ARG search backwards, else search forwards." 0)))) (found (progn - (when (and (< arg 0) - (python-info-looking-at-beginning-of-defun)) + (when (and (python-info-looking-at-beginning-of-defun) + (or (< arg 0) + ;; If looking at beginning of defun, and if + ;; pos is > line-content-start, ensure a + ;; backward re search match this defun by + ;; going to end of line before calling + ;; re-search-fn bug#40563 + (and (> arg 0) (> pos line-content-start)))) (end-of-line 1)) + (while (and (funcall re-search-fn python-nav-beginning-of-defun-regexp nil t) (or (python-syntax-context-type) @@ -1425,7 +1432,7 @@ With positive ARG search backwards, else search forwards." ;; backwards by checking indentation. (and (> arg 0) (not (= (current-indentation) 0)) - (>= (current-indentation) beg-indentation))))) + (>= (current-indentation) body-indentation))))) (and (python-info-looking-at-beginning-of-defun) (or (not (= (line-number-at-pos pos) (line-number-at-pos))) commit 252366866b5691965c8c752aa103ab157a6f3aaa Author: Lars Ingebrigtsen Date: Mon Dec 14 16:44:00 2020 +0100 Add a new recursively bound `current-minibuffer-command' variable * doc/lispref/commands.texi (Command Loop Info): Document it (bug#45177). * src/callint.c (Fcall_interactively): Bind it. * src/keyboard.c (syms_of_keyboard): Define current-minibuffer-command. diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index ebfda01671..15d7e4e3a7 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -928,6 +928,13 @@ remapping), and @code{this-original-command} gives the command that was specified to run but remapped into another command. @end defvar +@defvar current-minibuffer-command +This has the same value as @code{this-command}, but is bound +recursively when entering a minibuffer. This variable can be used +from minibuffer hooks and the like to determine what command opened +the current minibuffer session. +@end defvar + @defun this-command-keys This function returns a string or vector containing the key sequence that invoked the present command. Any events read by the command diff --git a/etc/NEWS b/etc/NEWS index 635da2d84a..a5e2c9cf26 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1437,6 +1437,12 @@ that makes it a valid button. ** Miscellaneous ++++ + +*** New variable 'current-minibuffer-command'. +This is like 'this-command', but is bound recursively when entering +the minibuffer. + +++ *** New function 'object-intervals'. This function returns a copy of the list of intervals (i.e., text diff --git a/src/callint.c b/src/callint.c index f80436f3d9..a221705f67 100644 --- a/src/callint.c +++ b/src/callint.c @@ -283,6 +283,11 @@ invoke it (via an `interactive' spec that contains, for instance, an Lisp_Object save_real_this_command = Vreal_this_command; Lisp_Object save_last_command = KVAR (current_kboard, Vlast_command); + /* Bound recursively so that code can check the current command from + code running from minibuffer hooks (and the like), without being + overwritten by subsequent minibuffer calls. */ + specbind (Qcurrent_minibuffer_command, Vreal_this_command); + if (NILP (keys)) keys = this_command_keys, key_count = this_command_key_count; else diff --git a/src/keyboard.c b/src/keyboard.c index dbca5be91e..54232aaea1 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -11830,6 +11830,13 @@ will be in `last-command' during the following command. */); doc: /* This is like `this-command', except that commands should never modify it. */); Vreal_this_command = Qnil; + DEFSYM (Qcurrent_minibuffer_command, "current-minibuffer-command"); + DEFVAR_LISP ("current-minibuffer-command", Vcurrent_minibuffer_command, + doc: /* This is like `this-command', but bound recursively. +Code running from (for instance) a minibuffer hook can check this variable +to see what command invoked the current minibuffer. */); + Vcurrent_minibuffer_command = Qnil; + DEFVAR_LISP ("this-command-keys-shift-translated", Vthis_command_keys_shift_translated, doc: /* Non-nil if the key sequence activating this command was shift-translated. commit f6454ad6cd0dba9ab7ebff9b2959c05a607442ed Author: Ulrich Ölmann Date: Mon Dec 14 16:02:54 2020 +0100 Add a DirectoryMode to the Emacs Server example * doc/emacs/misc.texi (Emacs Server): Update example * doc/emacs/misc.texi (Emacs Server): The socket containing directory is per default created with permissions 0755 by the socket-unit. However this is considered unsafe since commit [1], so enhance unit example with systemd configuration directive `DirectoryMode=' to create it with safe permissions, see https://www.freedesktop.org/software/systemd/man/systemd.socket.html#DirectoryMode= [1] 2003-04-12 "(server-socket-name): Use new safe location for socket." Copyright-paperwork-exempt: yes diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index c2c382ead0..54fafae565 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -1709,6 +1709,7 @@ connections. A setup to use this functionality could be: @example [Socket] ListenStream=/path/to/.emacs.socket +DirectoryMode=0700 [Install] WantedBy=sockets.target commit e8a358c3be90949645a1038cfd43553794c49441 Author: Stefan Kangas Date: Mon Dec 14 16:23:51 2020 +0100 Update value of frame-title-format in FAQ * doc/misc/efaq.texi (Displaying the current file name in the titlebar): Fix default value of frame-title-format. diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 9821bbe478..06a17d9c46 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -1692,7 +1692,7 @@ machine at which Emacs was invoked. This is done by setting @code{frame-title-format} to the default value of @lisp -(multiple-frames "%b" ("" invocation-name "@@" (system-name))) +(multiple-frames "%b" ("" "%b - GNU Emacs at " system-name)) @end lisp To modify the behavior such that frame titlebars contain the buffer's commit 5c361035dbcc1e1bc57c0c00db35753586a9a324 Author: Stefan Kangas Date: Mon Dec 14 16:22:22 2020 +0100 Don't recommend setnu and wb-line-number * doc/misc/efaq.texi (Displaying the current line or column): Remove reference to third-party alternatives to display-line-numbers-mode. diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index c926d7e97a..9821bbe478 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -1672,8 +1672,6 @@ would use with @code{display-line-numbers}. There is also the @samp{linum} package (distributed with Emacs since version 23.1) which will henceforth become obsolete. Users and developers are encouraged to use @samp{display-line-numbers} instead. -The packages @samp{setnu} and @samp{wb-line-number} (not distributed -with Emacs) also implement this feature. @node Displaying the current file name in the titlebar @section How can I modify the titlebar to contain the current file name? commit 95c9aad04117ce3ff2448be45ec873aa9841ca74 Author: Stefan Kangas Date: Mon Dec 14 15:48:38 2020 +0100 Remove more references to old versions from FAQ * doc/misc/efaq.texi (Learning how to do something) (Installing Emacs, Emacs for GNUstep, Emacs for macOS): Remove more references to Emacs 22 and older from FAQ. diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 462eb4cf3a..c926d7e97a 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -594,11 +594,11 @@ You can get a printed reference card listing commands and keys to invoke them. You can order one from the FSF for $2 (or 10 for $18), or you can print your own from the @file{etc/refcards/refcard.tex} or @file{etc/refcards/refcard.pdf} files in the Emacs distribution. -Beginning with version 21.1, the Emacs distribution comes with -translations of the reference card into several languages; look for -files named @file{etc/refcards/@var{lang}-refcard.*}, where @var{lang} -is a two-letter code of the language. For example, the German version -of the reference card is in the files @file{etc/refcards/de-refcard.tex} +The Emacs distribution comes with translations of the reference card +into several languages; look for files named +@file{etc/refcards/@var{lang}-refcard.*}, where @var{lang} is a +two-letter code of the language. For example, the German version of +the reference card is in the files @file{etc/refcards/de-refcard.tex} and @file{etc/refcards/de-refcard.pdf}. @item @@ -3322,7 +3322,7 @@ the main GNU distribution site, sources are available as @c Don't include VER in the file name, because pretests are not there. @uref{https://ftp.gnu.org/pub/gnu/emacs/emacs-VERSION.tar.gz} -(Replace @samp{VERSION} with the relevant version number, e.g., @samp{23.1}.) +(Replace @samp{VERSION} with the relevant version number, e.g., @samp{28.1}.) @item Next uncompress and extract the source files. This requires @@ -3622,8 +3622,8 @@ For MS-DOS, @pxref{Emacs for MS-DOS}. @section Where can I get Emacs for GNUstep? @cindex GNUstep, Emacs for -Beginning with version 23.1, Emacs supports GNUstep natively. -See the file @file{nextstep/INSTALL} in the distribution. +Emacs supports GNUstep natively. See the file @file{nextstep/INSTALL} +in the distribution. @node Emacs for macOS @section Where can I get Emacs for macOS? @@ -3631,8 +3631,8 @@ See the file @file{nextstep/INSTALL} in the distribution. @cindex Macintosh, Emacs for @cindex macOS, Emacs for -Beginning with version 22.1, Emacs supports macOS natively. -See the file @file{nextstep/INSTALL} in the distribution. +Emacs supports macOS natively. See the file @file{nextstep/INSTALL} +in the distribution. @c ------------------------------------------------------------ @node Key bindings commit 4c41a8acc0e3877404ab99e56420bcdd4e27bdc2 Author: Stefan Kangas Date: Mon Dec 14 15:16:13 2020 +0100 Make XEmacs compat variable warning-level-aliases obsolete * lisp/emacs-lisp/warnings.el (warning-level-aliases): Make obsolete. (display-warning): Warn when using one of the warning levels defined in above obsolete variable. (Bug#44849) * lisp/url/url-proxy.el (url-find-proxy-for-url): Replace obsolete warning type 'critical with :error. diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el index f525ea433a..28458847cc 100644 --- a/lisp/emacs-lisp/warnings.el +++ b/lisp/emacs-lisp/warnings.el @@ -67,6 +67,7 @@ Level :debug is ignored by default (see `warning-minimum-level').") Each element looks like (ALIAS . LEVEL) and defines ALIAS as equivalent to LEVEL. LEVEL must be defined in `warning-levels'; it may not itself be an alias.") +(make-obsolete-variable 'warning-level-aliases 'warning-levels "28.1") (define-obsolete-variable-alias 'display-warning-minimum-level 'warning-minimum-level "28.1") @@ -256,8 +257,10 @@ entirely by setting `warning-suppress-types' or (setq level :warning)) (unless buffer-name (setq buffer-name "*Warnings*")) - (if (assq level warning-level-aliases) - (setq level (cdr (assq level warning-level-aliases)))) + (with-suppressed-warnings ((obsolete warning-level-aliases)) + (when-let ((new (cdr (assq level warning-level-aliases)))) + (warn "Warning level `%s' is obsolete; use `%s' instead" level new) + (setq level new))) (or (< (warning-numeric-level level) (warning-numeric-level warning-minimum-log-level)) (warning-suppress-p type warning-suppress-log-types) diff --git a/lisp/url/url-proxy.el b/lisp/url/url-proxy.el index 698a87098b..ad04a2d94a 100644 --- a/lisp/url/url-proxy.el +++ b/lisp/url/url-proxy.el @@ -59,7 +59,7 @@ ((string-match "^socks +" proxy) (concat "socks://" (substring proxy (match-end 0)))) (t - (display-warning 'url (format "Unknown proxy directive: %s" proxy) 'critical) + (display-warning 'url (format "Unknown proxy directive: %s" proxy) :error) nil)))) (autoload 'url-http "url-http") commit f1dae2551c9b30f1f1333416df195b0907c54f4f Author: Stefan Kangas Date: Mon Dec 14 15:09:14 2020 +0100 Prefer setq to set+quote * lisp/cedet/semantic/senator.el (senator-lazy-highlight-update): * lisp/emulation/edt.el (edt-find, edt-restore-key) (edt-remember): * lisp/eshell/em-ls.el (eshell-ls--insert-directory): * lisp/net/tramp-sh.el (tramp-sh-handle-write-region): * lisp/progmodes/hideif.el (hide-ifdef-mode): * test/lisp/url/url-future-tests.el (url-future-tests): Prefer setq to set+quote. diff --git a/lisp/cedet/semantic/senator.el b/lisp/cedet/semantic/senator.el index 49c1933508..d21350749b 100644 --- a/lisp/cedet/semantic/senator.el +++ b/lisp/cedet/semantic/senator.el @@ -810,7 +810,7 @@ if available." (defun senator-lazy-highlight-update () "Force lazy highlight update." (lazy-highlight-cleanup t) - (set 'isearch-lazy-highlight-last-string nil) + (setq isearch-lazy-highlight-last-string nil) (setq isearch-adjusted t) (isearch-update)) diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el index f61de9208d..7601731a85 100644 --- a/lisp/emulation/edt.el +++ b/lisp/emulation/edt.el @@ -691,7 +691,7 @@ Optional argument FIND is t if this function is called from `edt-find'." (defun edt-find () "Find first occurrence of string in current direction and save it." (interactive) - (set 'edt-find-last-text (read-string "Search: ")) + (setq edt-find-last-text (read-string "Search: ")) (if (equal edt-direction-string edt-forward-string) (edt-find-forward t) (edt-find-backward t))) @@ -1321,8 +1321,8 @@ Definition is stored in `edt-last-replaced-key-definition'." (if edt-last-replaced-key-definition (progn (let (edt-key-definition) - (set 'edt-key-definition - (read-key-sequence "Press the key to be restored: ")) + (setq edt-key-definition + (read-key-sequence "Press the key to be restored: ")) (if (string-equal "\C-m" edt-key-definition) (message "Key not restored") (progn @@ -1639,12 +1639,12 @@ Argument NUM is the number of times to duplicate the line." (progn (end-kbd-macro nil) (let (edt-key-definition) - (set 'edt-key-definition - (read-key-sequence "Enter key for binding: ")) + (setq edt-key-definition + (read-key-sequence "Enter key for binding: ")) (if (string-equal "\C-m" edt-key-definition) (message "Key sequence not remembered") (progn - (set 'edt-learn-macro-count (+ edt-learn-macro-count 1)) + (setq edt-learn-macro-count (+ edt-learn-macro-count 1)) (setq edt-last-replaced-key-definition (lookup-key (current-global-map) edt-key-definition)) diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index 6b306f7787..44a0df6a3e 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -274,9 +274,9 @@ instead." (font-lock-mode -1) (setq font-lock-defaults nil) (if (boundp 'font-lock-buffers) - (set 'font-lock-buffers - (delq (current-buffer) - (symbol-value 'font-lock-buffers))))) + (setq font-lock-buffers + (delq (current-buffer) + (symbol-value 'font-lock-buffers))))) (require 'em-glob) (let* ((insert-func 'insert) (error-func 'insert) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 98537a100f..34be4fcba9 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3562,7 +3562,7 @@ implementation will be used." ;; Make `last-coding-system-used' have the right value. (when coding-system-used - (set 'last-coding-system-used coding-system-used)))) + (setq last-coding-system-used coding-system-used)))) (tramp-flush-file-properties v localname) diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 7cbc9708fc..9c8343fca0 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -304,7 +304,7 @@ Several variables affect how the hiding is done: ;; (C-c @ C) every time before hiding current buffer. ;; (setq-local hide-ifdef-env ;; (default-value 'hide-ifdef-env)) - (set 'hide-ifdef-env (default-value 'hide-ifdef-env)) + (setq hide-ifdef-env (default-value 'hide-ifdef-env)) ;; Some C/C++ headers might have other ways to prevent reinclusion and ;; thus would like `hide-ifdef-expand-reinclusion-protection' to be nil. (setq-local hide-ifdef-expand-reinclusion-protection diff --git a/test/lisp/url/url-future-tests.el b/test/lisp/url/url-future-tests.el index a07730a2be..43668036b6 100644 --- a/test/lisp/url/url-future-tests.el +++ b/test/lisp/url/url-future-tests.el @@ -31,13 +31,13 @@ (let* (url-future-tests--saver (text "running future") (good (make-url-future :value (lambda () (format text)) - :callback (lambda (f) (set 'url-future-tests--saver f)))) + :callback (lambda (f) (setq url-future-tests--saver f)))) (bad (make-url-future :value (lambda () (/ 1 0)) - :errorback (lambda (&rest d) (set 'url-future-tests--saver d)))) + :errorback (lambda (&rest d) (setq url-future-tests--saver d)))) (tocancel (make-url-future :value (lambda () (/ 1 0)) - :callback (lambda (f) (set 'url-future-tests--saver f)) + :callback (lambda (f) (setq url-future-tests--saver f)) :errorback (lambda (&rest d) - (set 'url-future-tests--saver d))))) + (setq url-future-tests--saver d))))) (should (equal good (url-future-call good))) (should (equal good url-future-tests--saver)) (should (equal text (url-future-value good))) commit c9758ba48a805406ddd538aac33354fa400ac14a Author: Stefan Kangas Date: Mon Dec 14 14:52:46 2020 +0100 * lisp/bookmark.el: Doc fix. diff --git a/lisp/bookmark.el b/lisp/bookmark.el index b9bdbe86d6..afcfd2e425 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -26,7 +26,8 @@ ;; This package is for setting "bookmarks" in files. A bookmark ;; associates a string with a location in a certain file. Thus, you ;; can navigate your way to that location by providing the string. -;; See the "User Variables" section for customizations. +;; +;; Type `M-x customize-group RET boomark RET' for user options. ;;; Code: commit 6858119bcd4c34f5a28440b69803e9d7f99a35f7 Author: Mattias Engdegård Date: Mon Dec 14 12:31:54 2020 +0100 ; * lisp/progmodes/project.el (project-switch-use-entire-map): Typo diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index d4c0e46c85..d786c3f967 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1281,7 +1281,7 @@ If nil, `project-switch-project' will only recognize commands listed in `project-switch-commands' and signal an error when others are invoked. Otherwise, all keys in `project-prefix-map' are legal even if they aren't listed in the dispatch menu." - :type 'bool + :type 'boolean :version "28.1") (defun project--keymap-prompt () commit c42965745daa607ac434c56ce19a37a94fb9a2c7 Merge: c6c4e74603 62d14e10f9 Author: Torsten Hilbrich Date: Mon Dec 14 12:09:41 2020 +0100 Merge branch 'feature/integration-of-dictionary-el' b6227446d9 Importing dictionary module 658ec3ccee Renamed connection.el e2ebffdd62 Renamed link.el 723906c444 Removed some compability parts in dictionary 5dc17d73b0 Add :version tag to defcustom statement 49c250b388 Dont't check coding-system-list for existence 99a7e918c8 Don't check for existence of defface 1773b9b687 Dictionary now uses button 329b6a0210 Adding details page for dictionary 837505075c Fix dictionary tooltip mode 2f1e4fbc42 Support nil value for dictionary-server 91ff1c8f7c Move placement of dictionary-tooltip-mouse-event 28fe134971 Remove text property from empty line 7ca331a4f9 Add history of search words to read-string d5a4da25b0 * lisp/net/dictionary.el: Remove remnants of package cc5f280378 * lisp/net/dictionary.el: Add lexical-binding:t 09952ce434 Removed useless check for popup-menu 81ebe86d8d Show error message when asking to match for nothing 0044a2e888 * lisp/net/dictionary-connection.el: Add lexical-binding:t f58443780c * lisp/net/dictionary-connection.el: Remove obsolete Version 54a3964e29 Update GPL version a557a103cc * lisp/net/dictionary-connection.el: Prefer defsubst ffa7d6671d * lisp/net/dictionary.el: Prefer defsubst over defmacro 4deb8618e4 * lisp/net/dictionary.el (dictionary-mode): Use setq-local d30618cbc1 * lisp/net/dictionary.el (dictionary-tooltip-mode): Use ... a25a12ddaf Use when where else case returns nil 89e9c1686e * lisp/net/dictionary.el (dictionary-display-more-info): ... d466231c3e A number of docstring fixes b18217eb87 A number of docstring fixes ca0de4d1e0 * etc/NEWS: Add entry for dictionary.el 62d14e10f9 * lisp/net/dictionary.el (dictionary-pre-buffer): Unify casing commit 62d14e10f9dc52136d951a5702ba70d4be171d84 (refs/remotes/origin/feature/integration-of-dictionary-el) Author: Torsten Hilbrich Date: Mon Dec 14 11:44:12 2020 +0100 * lisp/net/dictionary.el (dictionary-pre-buffer): Unify casing Let all the buttons begins with an upper-case character and the rest of the text is lower-case. diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index f06efaea37..0df9d8b142 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -742,7 +742,7 @@ of matching words." 'callback 'dictionary-restore-state 'help-echo (purecopy "Mouse-2 to go backwards in history")) (insert " ") - (insert-button "[Search Definition]" :type 'dictionary-button + (insert-button "[Search definition]" :type 'dictionary-button 'callback 'dictionary-search 'help-echo (purecopy "Mouse-2 to look up a new word")) (insert " ") @@ -758,11 +758,11 @@ of matching words." (insert "\n ") - (insert-button "[Select Dictionary]" :type 'dictionary-button + (insert-button "[Select dictionary]" :type 'dictionary-button 'callback 'dictionary-select-dictionary 'help-echo (purecopy "Mouse-2 to select dictionary for future searches")) (insert " ") - (insert-button "[Select Match Strategy]" :type 'dictionary-button + (insert-button "[Select match strategy]" :type 'dictionary-button 'callback 'dictionary-select-strategy 'help-echo (purecopy "Mouse-2 to select matching algorithm")) (insert "\n\n"))) commit ca0de4d1e0bd718568dfca8daf5498754145941a Author: Torsten Hilbrich Date: Mon Dec 14 11:31:51 2020 +0100 * etc/NEWS: Add entry for dictionary.el diff --git a/etc/NEWS b/etc/NEWS index 63a740cf64..843e93d508 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1338,6 +1338,15 @@ These themes are designed for colour-contrast accessibility. You can load the new themes using 'M-x customize-themes' or 'load-theme' from your init file. +** Dictionary mode + +This is a mode for searching a RFC 2229 dictionary +server. 'dictionary' opens a buffer for starting +operations. 'dictionary-search' performs a lookup for a word. It also +supports a 'dictionary-tooltip-mode' which performs a lookup of the +word under the mouse in 'dictionary-tooltip-dictionary' (which must be +customized first). + * Incompatible Editing Changes in Emacs 28.1 commit b18217eb870c45b0a49d29f2f96e67b5554fc4fb Author: Torsten Hilbrich Date: Mon Dec 14 11:09:22 2020 +0100 A number of docstring fixes * lisp/net/dictionary-connection.el (dictionary-connection-p, dictionary-connection-read-point, dictionary-connection-process, dictionary-connection-buffer, dictionary-connection-set-read-point, dictionary-connection-set-process, dictionary-connection-set-buffer, dictionary-connection-create-data, dictionary-connection-open, dictionary-connection-status, dictionary-connection-close, dictionary-connection-send, dictionary-connection-send-crlf, dictionary-connection-read, dictionary-connection-read-crlf, dictionary-connection-read-to-point): Fix docstring diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el index 0d93d978df..d88c0b48f9 100644 --- a/lisp/net/dictionary-connection.el +++ b/lisp/net/dictionary-connection.el @@ -28,35 +28,35 @@ ;;; Code: (defsubst dictionary-connection-p (connection) - "Returns non-nil if `connection' is a connection object" + "Returns non-nil if CONNECTION is a connection object." (get connection 'connection)) (defsubst dictionary-connection-read-point (connection) - "Return the read point of the connection object." + "Return the read point of the CONNECTION object." (get connection 'dictionary-connection-read-point)) (defsubst dictionary-connection-process (connection) - "Return the process of the connection object." + "Return the process of the CONNECTION object." (get connection 'dictionary-connection-process)) (defsubst dictionary-connection-buffer (connection) - "Return the buffer of the connection object." + "Return the buffer of the CONNECTION object." (get connection 'dictionary-connection-buffer)) (defsubst dictionary-connection-set-read-point (connection point) - "Set the read-point for `connection' to `point'." + "Set the read-point for CONNECTION to POINT." (put connection 'dictionary-connection-read-point point)) (defsubst dictionary-connection-set-process (connection process) - "Set the process for `connection' to `process'." + "Set the process for CONNECTION to PROCESS." (put connection 'dictionary-connection-process process)) (defsubst dictionary-connection-set-buffer (connection buffer) - "Set the buffer for `connection' to `buffer'." + "Set the buffer for CONNECTION to BUFFER." (put connection 'dictionary-connection-buffer buffer)) (defun dictionary-connection-create-data (buffer process point) - "Create a new connection data based on `buffer', `process', and `point'." + "Create a new connection data based on BUFFER, PROCESS, and POINT." (let ((connection (make-symbol "connection"))) (put connection 'connection t) (dictionary-connection-set-read-point connection point) @@ -65,7 +65,7 @@ connection)) (defun dictionary-connection-open (server port) - "Open a connection to `server' and `port'. + "Open a connection to SERVER at PORT. A data structure identifing the connection is returned" (let ((process-buffer (generate-new-buffer (format " connection to %s:%s" @@ -78,7 +78,7 @@ A data structure identifing the connection is returned" (dictionary-connection-create-data process-buffer process (point-min))))) (defun dictionary-connection-status (connection) - "Return the status of the connection. + "Return the status of the CONNECTION. Possible return values are the symbols: nil: argument is no connection object 'none: argument has no connection @@ -97,7 +97,7 @@ nil: argument is no connection object 'up)))))) (defun dictionary-connection-close (connection) - "Force closing of the connection." + "Force closing of the CONNECTION." (when (dictionary-connection-p connection) (let ((buffer (dictionary-connection-buffer connection)) (process (dictionary-connection-process connection))) @@ -110,7 +110,7 @@ nil: argument is no connection object (dictionary-connection-set-buffer connection nil)))) (defun dictionary-connection-send (connection data) - "Send `data' to the process." + "Send DATA to the process stored in CONNECTION." (unless (eq (dictionary-connection-status connection) 'up) (error "Connection is not up")) (with-current-buffer (dictionary-connection-buffer connection) @@ -119,11 +119,11 @@ nil: argument is no connection object (process-send-string (dictionary-connection-process connection) data))) (defun dictionary-connection-send-crlf (connection data) - "Send `data' together with CRLF to the process." + "Send DATA together with CRLF to the process found in CONNECTION." (dictionary-connection-send connection (concat data "\r\n"))) (defun dictionary-connection-read (connection delimiter) - "Read data until `delimiter' is found inside the buffer." + "Read data from CONNECTION until DELIMITER is found inside the buffer." (unless (eq (dictionary-connection-status connection) 'up) (error "Connection is not up")) (let ((case-fold-search nil) @@ -142,11 +142,13 @@ nil: argument is no connection object result)))) (defun dictionary-connection-read-crlf (connection) - "Read until a line is completedx with CRLF" + "Read from CONNECTION until a line is completed with CRLF." (dictionary-connection-read connection "\015?\012")) (defun dictionary-connection-read-to-point (connection) - "Read until a line is consisting of a single point" + "Read from CONNECTION until an end of entry is encountered. +End of entry is a decimal point found on a line by itself. +" (dictionary-connection-read connection "\015?\012[.]\015?\012")) (provide 'dictionary-connection) commit d466231c3e3fca3e9f1b772ca9417a038d05d982 Author: Torsten Hilbrich Date: Mon Dec 14 10:55:35 2020 +0100 A number of docstring fixes * lisp/net/dictionary.el (dictionary-set-server-var, dictionary-mode, dictionary, dictionary-new-buffer, dictionary-reply-code, dictionary-reply, dictionary-reply-list, dictionary-open-server, dictionary-check-connection, dictionary-mode-p, dictionary-close, dictionary-read-reply, dictionary-split-string, dictionary-read-reply-and-split, dictionary-read-answer, dictionary-check-reply, dictionary-coding-system, dictionary-decode-charset, dictionary-encode-charset, dictionary-check-initial-reply, dictionary-store-state, dictionary-restore-state, dictionary-new-search, dictionary-new-search-internal, dictionary-do-search, dictionary-pre-buffer, dictionary-post-buffer, dictionary-display-search-result, dictionary-display-word-entry, dictionary-display-word-definition, dictionary-mark-reference, dictionary-select-dictionary, dictionary-display-dictionarys, dictionary-display-dictionary-line, dictionary-set-dictionary, dictionary-special-dictionary, dictionary-display-more-info, dictionary-select-strategy, dictionary-do-select-strategy, dictionary-display-strategies, dictionary-display-strategy-line, dictionary-set-strategy, dictionary-new-matching, dictionary-do-matching, dictionary-display-only-match-result, dictionary-display-match-result, dictionary-display-match-result, dictionary-display-match-lines, dictionary-search, dictionary-previous, dictionary-help, dictionary-match-words, dictionary-mouse-popup-matching-words, dictionary-popup-matching-words, dictionary-tooltip-mode, dictionary-tooltip-mouse-event): Fix docstring The following kind of changes were made: - finish first line with a full stop (.) - mention parameter in upper-case whenever possible (considering the length constraints) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 1ac6c6838b..f06efaea37 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -44,6 +44,10 @@ (defvar dictionary-current-server) (defun dictionary-set-server-var (name value) + "Customize helper for setting variable NAME to VALUE. +The helper is used by customize to check for an active connection +when setting a variable. The user has then the choice to close +the existing connection." (if (and (boundp 'dictionary-connection) dictionary-connection (eq (dictionary-connection-status dictionary-connection) 'up) @@ -352,24 +356,25 @@ is utf-8" ;;;###autoload (defun dictionary-mode () - "This is a mode for searching a dictionary server implementing - the protocol defined in RFC 2229. + "Mode for searching a dictionary. +This is a mode for searching a dictionary server implementing the +protocol defined in RFC 2229. - This is a quick reference to this mode describing the default key bindings: +This is a quick reference to this mode describing the default key bindings: - * q close the dictionary buffer - * h display this help information - * s ask for a new word to search - * d search the word at point - * n or Tab place point to the next link - * p or S-Tab place point to the prev link +* q close the dictionary buffer +* h display this help information +* s ask for a new word to search +* d search the word at point +* n or Tab place point to the next link +* p or S-Tab place point to the prev link - * m ask for a pattern and list all matching words. - * D select the default dictionary - * M select the default search strategy +* m ask for a pattern and list all matching words. +* D select the default dictionary +* M select the default search strategy - * Return or Button2 visit that link - " +* Return or Button2 visit that link +" (unless (eq major-mode 'dictionary-mode) (cl-incf dictionary-instances)) @@ -394,7 +399,7 @@ is utf-8" ;;;###autoload (defun dictionary () - "Create a new dictonary buffer and install dictionary-mode" + "Create a new dictonary buffer and install dictionary-mode." (interactive) (let ((buffer (or (and dictionary-use-single-buffer (get-buffer "*Dictionary*")) @@ -413,25 +418,27 @@ is utf-8" (dictionary-store-state 'dictionary-new-buffer nil))) (defun dictionary-new-buffer () - "Create a new and clean buffer" + "Create a new and clean buffer." (dictionary-pre-buffer) (dictionary-post-buffer)) (defsubst dictionary-reply-code (reply) - "Return the reply code stored in `reply'." + "Return the reply code stored in REPLY." (get reply 'reply-code)) (defsubst dictionary-reply (reply) - "Return the string reply stored in `reply'." + "Return the string reply stored in REPLY." (get reply 'reply)) (defsubst dictionary-reply-list (reply) - "Return the reply list stored in `reply'." + "Return the reply list stored in REPLY." (get reply 'reply-list)) (defun dictionary-open-server (server) - "Opens a new connection to this server" + "Opens a new connection to SERVER. +The connection takes the proxy setting in customization group +`dictionary-proxy' into account." (let ((wanted 'raw-text) (coding-system nil)) (if (member wanted (coding-system-list)) @@ -481,7 +488,7 @@ is utf-8" (dictionary-reply reply))))))) (defun dictionary-check-connection () - "Check if there is already a connection open" + "Check if there is already a connection open." (if (not (and dictionary-connection (eq (dictionary-connection-status dictionary-connection) 'up))) (if dictionary-server @@ -497,7 +504,7 @@ is utf-8" (error "Failed automatic server selection, please customize dictionary-server")))))))) (defun dictionary-mode-p () - "Return non-nil if current buffer has dictionary-mode" + "Return non-nil if current buffer has dictionary-mode." (eq major-mode 'dictionary-mode)) (defun dictionary-ensure-buffer () @@ -510,7 +517,7 @@ is utf-8" ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun dictionary-close () - "Close the current dictionary buffer and its connection" + "Close the current dictionary buffer and its connection." (interactive) (if (eq major-mode 'dictionary-mode) (progn @@ -534,14 +541,14 @@ is utf-8" (dictionary-connection-send-crlf dictionary-connection string)) (defun dictionary-read-reply () - "Read the reply line from the server" + "Read the reply line from the server." (let ((answer (dictionary-connection-read-crlf dictionary-connection))) (if (string-match "\r?\n" answer) (substring answer 0 (match-beginning 0)) answer))) (defun dictionary-split-string (string) - "Split the `string' constiting of space separated words into elements. + "Split STRING constiting of space-separated words into elements. This function knows about the special meaning of quotes (\")" (let ((list)) (while (and string (> (length string) 0)) @@ -559,7 +566,7 @@ This function knows about the special meaning of quotes (\")" (nreverse list))) (defun dictionary-read-reply-and-split () - "Read the reply, split it into words and return it" + "Reads the reply, splits it into words and returns it." (let ((answer (make-symbol "reply-data")) (reply (dictionary-read-reply))) (let ((reply-list (dictionary-split-string reply))) @@ -569,7 +576,8 @@ This function knows about the special meaning of quotes (\")" answer))) (defun dictionary-read-answer () - "Read an answer delimited by a . on a single line" + "Read the complete answer. +The answer is delimited by a decimal point (.) on a line by itself." (let ((answer (dictionary-connection-read-to-point dictionary-connection)) (start 0)) (while (string-match "\r\n" answer start) @@ -581,13 +589,13 @@ This function knows about the special meaning of quotes (\")" answer)) (defun dictionary-check-reply (reply code) - "Check if the reply in `reply' has the `code'." + "Extract the reply code from REPLY and checks against CODE." (let ((number (dictionary-reply-code reply))) (and (numberp number) (= number code)))) (defun dictionary-coding-system (dictionary) - "Select coding system to use for that dictionary" + "Select coding system to use for DICTIONARY." (let ((coding-system (or (cdr (assoc dictionary dictionary-coding-systems-for-dictionaries)) @@ -597,14 +605,14 @@ This function knows about the special meaning of quotes (\")" nil))) (defun dictionary-decode-charset (text dictionary) - "Convert the text from the charset defined by the dictionary given." + "Convert TEXT from the charset configured for DICTIONARY." (let ((coding-system (dictionary-coding-system dictionary))) (if coding-system (decode-coding-string text coding-system) text))) (defun dictionary-encode-charset (text dictionary) - "Convert the text to the charset defined by the dictionary given." + "Convert TEXT to the charset defined for DICTIONARY." (let ((coding-system (dictionary-coding-system dictionary))) (if coding-system (encode-coding-string text coding-system) @@ -615,7 +623,7 @@ This function knows about the special meaning of quotes (\")" ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun dictionary-check-initial-reply () - "Read the first reply from server and check it." + "Reads the first reply from server and checks it." (let ((reply (dictionary-read-reply-and-split))) (unless (dictionary-check-reply reply 220) (dictionary-connection-close dictionary-connection) @@ -623,8 +631,10 @@ This function knows about the special meaning of quotes (\")" ;; Store the current state (defun dictionary-store-state (function data) - "Stores the current state of operation for later restore." - + "Stores the current state of operation for later restore. +The current state consist of a tuple of FUNCTION and DATA. This +is basically an implementation of a history to return to a +previous state." (if dictionary-current-data (progn (push dictionary-current-data dictionary-data-stack) @@ -641,7 +651,7 @@ This function knows about the special meaning of quotes (\")" ;; Restore the previous state (defun dictionary-restore-state (&rest ignored) - "Restore the state just before the last operation" + "Restore the state just before the last operation." (let ((position (pop dictionary-position-stack)) (data (pop dictionary-data-stack))) (unless position @@ -654,7 +664,9 @@ This function knows about the special meaning of quotes (\")" ;; The normal search (defun dictionary-new-search (args &optional all) - "Save the current state and start a new search" + "Saves the current state and starts a new search based on ARGS. +The parameter ARGS is a cons cell where car is the word to search +and cdr is the dictionary where to search the word in." (interactive) (dictionary-store-positions) (let ((word (car args)) @@ -668,12 +680,16 @@ This function knows about the special meaning of quotes (\")" (list word dictionary 'dictionary-display-search-result)))) (defun dictionary-new-search-internal (word dictionary function) - "Starts a new search after preparing the buffer" + "Starts a new search for WORD in DICTIONARY after preparing the buffer. +FUNCTION is the callback which is called for each search result. +" (dictionary-pre-buffer) (dictionary-do-search word dictionary function)) (defun dictionary-do-search (word dictionary function &optional nomatching) - "The workhorse for doing the search" + "Searches WORD in DICTIONARY and calls FUNCTION for each result. +The parameter NOMATCHING controls whether to suppress the display +of matching words." (message "Searching for %s in %s" word dictionary) (dictionary-send-command (concat "define " @@ -717,7 +733,7 @@ This function knows about the special meaning of quotes (\")" 'face 'dictionary-button-face) (defun dictionary-pre-buffer () - "These commands are executed at the begin of a new buffer" + "These commands are executed at the begin of a new buffer." (setq buffer-read-only nil) (erase-buffer) (if dictionary-create-buttons @@ -753,14 +769,14 @@ This function knows about the special meaning of quotes (\")" (setq dictionary-marker (point-marker))) (defun dictionary-post-buffer () - "These commands are executed at the end of a new buffer" + "These commands are executed at the end of a new buffer." (goto-char dictionary-marker) (set-buffer-modified-p nil) (setq buffer-read-only t)) (defun dictionary-display-search-result (reply) - "This function starts displaying the result starting with the `reply'." + "This function starts displaying the result in REPLY." (let ((number (nth 1 (dictionary-reply-list reply)))) (insert number (if (equal number "1") @@ -780,7 +796,8 @@ This function knows about the special meaning of quotes (\")" (dictionary-post-buffer))) (defun dictionary-display-word-entry (dictionary description) - "Insert an explanation for the current definition." + "Insert an explanation for DESCRIPTION from DICTIONARY. +The DICTIONARY is only used for decoding the bytes to display the DESCRIPTION." (let ((start (point))) (insert "From " dictionary-description-open-delimiter @@ -791,7 +808,10 @@ This function knows about the special meaning of quotes (\")" (insert "\n\n"))) (defun dictionary-display-word-definition (reply word dictionary) - "Insert the definition for the current word" + "Insert the definition in REPLY for the current WORD from DICTIONARY. +It will replace links which are found in the REPLY and replace +them with buttons to perform a a new search. +" (let ((start (point))) (insert (dictionary-decode-charset reply dictionary)) (insert "\n\n") @@ -817,8 +837,8 @@ This function knows about the special meaning of quotes (\")" (goto-char (point-max))))))) (defun dictionary-mark-reference (start end call displayed-word dictionary) - "Format the area from `start' to `end' as link calling `call'. -The word is taken from the buffer, the `dictionary' is given as argument." + "Format the area from START to END as link calling CALL. +The word is taken from the buffer, the DICTIONARY is given as argument." (let ((word (buffer-substring-no-properties start end))) (while (string-match "\n\\s-*" word) (setq word (replace-match " " t t word))) @@ -833,7 +853,7 @@ The word is taken from the buffer, the `dictionary' is given as argument." word "\" in \"" dictionary "\""))))) (defun dictionary-select-dictionary (&rest ignored) - "Save the current state and start a dictionary selection" + "Save the current state and start a dictionary selection." (interactive) (dictionary-ensure-buffer) (dictionary-store-positions) @@ -869,7 +889,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (nreverse (cons (substring string start) parts)))) (defun dictionary-display-dictionarys () - "Handle the display of all dictionaries existing on the server" + "Handle the display of all dictionaries existing on the server." (dictionary-pre-buffer) (insert "Please select your default dictionary:\n\n") (dictionary-display-dictionary-line "* \"All dictionaries\"") @@ -880,7 +900,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (dictionary-post-buffer)) (defun dictionary-display-dictionary-line (string) - "Display a single dictionary" + "Display a single dictionary and its description read from STRING." (let* ((list (dictionary-split-string string)) (dictionary (car list)) (description (cadr list)) @@ -901,7 +921,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (insert "\n"))))) (defun dictionary-set-dictionary (param &optional more) - "Select this dictionary as new default" + "Select the dictionary which is the car of PARAM as new default." (if more (dictionary-display-more-info param) @@ -911,12 +931,12 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (message "Dictionary %s has been selected" dictionary)))) (defun dictionary-special-dictionary (name) - "Checks whether the special * or ! dictionary are seen" + "Checks whether the special * or ! dictionary are seen in NAME." (or (equal name "*") (equal name "!"))) (defun dictionary-display-more-info (param) - "Display the available information on the dictionary" + "Display the available information on the dictionary found in PARAM." (let ((dictionary (car param)) (description (cdr param))) @@ -945,7 +965,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (dictionary-store-state 'dictionary-display-more-info dictionary)))) (defun dictionary-select-strategy (&rest ignored) - "Save the current state and start a strategy selection" + "Save the current state and start a strategy selection." (interactive) (dictionary-ensure-buffer) (dictionary-store-positions) @@ -968,7 +988,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (dictionary-display-strategies)))) (defun dictionary-display-strategies () - "Handle the display of all strategies existing on the server" + "Handle the display of all strategies existing on the server." (dictionary-pre-buffer) (insert "Please select your default search strategy:\n\n") (dictionary-display-strategy-line ". \"The servers default\"") @@ -978,7 +998,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (dictionary-post-buffer)) (defun dictionary-display-strategy-line (string) - "Display a single strategy" + "Display a single strategy found in STRING." (let* ((list (dictionary-split-string string)) (strategy (car list)) (description (cadr list))) @@ -991,13 +1011,13 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (insert "\n"))))) (defun dictionary-set-strategy (strategy &rest ignored) - "Select this strategy as new default" + "Select this STRATEGY as new default" (setq dictionary-default-strategy strategy) (dictionary-restore-state) (message "Strategy %s has been selected" strategy)) (defun dictionary-new-matching (word) - "Run a new matching search on `word'." + "Run a new matching search on WORD." (dictionary-ensure-buffer) (dictionary-store-positions) (dictionary-do-matching word dictionary-default-dictionary @@ -1009,7 +1029,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." 'dictionary-display-match-result))) (defun dictionary-do-matching (word dictionary strategy function) - "Ask the server about matches to `word' and display it." + "Find matches for WORD with STRATEGY in DICTIONARY and displays them with FUNCTION." (message "Lookup matching words for %s in %s using %s" word dictionary strategy) @@ -1033,7 +1053,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (funcall function reply))) (defun dictionary-display-only-match-result (reply) - "Display the results from the current matches without the headers." + "Display the results from the current matches in REPLY without the headers." (let ((number (nth 1 (dictionary-reply-list reply))) (list (dictionary-simple-split-string (dictionary-read-answer) "\n+"))) @@ -1055,7 +1075,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (dictionary-display-match-lines (reverse result))))) (defun dictionary-display-match-result (reply) - "Display the results from the current matches." + "Display the results in REPLY from a match operation." (dictionary-pre-buffer) (let ((number (nth 1 (dictionary-reply-list reply))) @@ -1079,7 +1099,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (dictionary-post-buffer)) (defun dictionary-display-match-lines (list) - "Display the match lines." + "Display a line for each match found in LIST." (mapc (lambda (item) (let ((dictionary (car item)) (word-list (cdr item))) @@ -1109,8 +1129,9 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." ;;;###autoload (defun dictionary-search (word &optional dictionary) - "Search the `word' in `dictionary' if given or in all if nil. -It presents the word at point as default input and allows editing it." + "Search the WORD in DICTIONARY if given or in all if nil. +It presents the selection or word at point as default input and +allows editing it." (interactive (list (let ((default (dictionary-search-default))) (read-string (if default @@ -1139,20 +1160,20 @@ It presents the word at point as default input and allows editing it." (dictionary-new-search (cons (current-word) dictionary-default-dictionary))) (defun dictionary-previous () - "Go to the previous location in the current buffer" + "Go to the previous location in the current buffer." (interactive) (unless (dictionary-mode-p) (error "Current buffer is no dictionary buffer")) (dictionary-restore-state)) (defun dictionary-help () - "Display a little help" + "Display a little help." (interactive) (describe-function 'dictionary-mode)) ;;;###autoload (defun dictionary-match-words (&optional pattern &rest ignored) - "Search `pattern' in current default dictionary using default strategy." + "Search PATTERN in current default dictionary using default strategy." (interactive) ;; can't use interactive because of mouse events (or pattern @@ -1162,7 +1183,7 @@ It presents the word at point as default input and allows editing it." ;;;###autoload (defun dictionary-mouse-popup-matching-words (event) - "Display entries matching the word at the cursor" + "Display entries matching the word at the cursor retrieved using EVENT." (interactive "e") (let ((word (save-window-excursion (save-excursion @@ -1173,7 +1194,7 @@ It presents the word at point as default input and allows editing it." ;;;###autoload (defun dictionary-popup-matching-words (&optional word) - "Display entries matching the word at the point" + "Display entries matching WORD or the current word if not given." (interactive) (dictionary-do-matching (or word (current-word) (error "Nothing to search for")) dictionary-default-dictionary @@ -1208,7 +1229,7 @@ It presents the word at point as default input and allows editing it." ;; Add a mode indicater named "Dict" (defvar dictionary-tooltip-mode nil - "Indicates wheather the dictionary tooltip mode is active") + "Indicates wheather the dictionary tooltip mode is active.") (nconc minor-mode-alist '((dictionary-tooltip-mode " Dict"))) (defcustom dictionary-tooltip-dictionary @@ -1244,7 +1265,7 @@ It presents the word at point as default input and allows editing it." (current-word)))))) (defvar dictionary-tooltip-mouse-event nil - "Event that triggered the tooltip mode") + "Event that triggered the tooltip mode.") (defun dictionary-display-tooltip (&ignore) "Search the current word in the `dictionary-tooltip-dictionary'." @@ -1288,8 +1309,8 @@ will be set to nil. "Display tooltips for the current word. This function can be used to enable or disable the tooltip mode -for the current buffer. If global-tooltip-mode is active it will -overwrite that mode for the current buffer. +for the current buffer (based on ARG). If global-tooltip-mode is +active it will overwrite that mode for the current buffer. " (interactive "P") commit 89e9c1686e99c2b6369f6aa858ed3a347b940c4f Author: Torsten Hilbrich Date: Mon Dec 14 09:52:23 2020 +0100 * lisp/net/dictionary.el (dictionary-display-more-info): Spelling fix Fix the spelling in the error message for non-existing dictionary. diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index afa4d393c0..1ac6c6838b 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -928,7 +928,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (let ((reply (dictionary-read-reply-and-split))) (message nil) (if (dictionary-check-reply reply 550) - (error "Dictionary \"%s\" not existing" dictionary) + (error "Dictionary \"%s\" does not exist" dictionary) (unless (dictionary-check-reply reply 112) (error "Unknown server answer: %s" (dictionary-reply reply))) (dictionary-pre-buffer) commit a25a12ddaf61389030a1afaa535d5563856cfc70 Author: Torsten Hilbrich Date: Mon Dec 14 09:48:26 2020 +0100 Use when where else case returns nil * lisp/net/dictionary-connection.el (dictionary-connection-status, dictionary-connection-close): Instead of returning nil in the else case of the if just use when. Was suggested by Stefan Kangas. diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el index c762b352b7..0d93d978df 100644 --- a/lisp/net/dictionary-connection.el +++ b/lisp/net/dictionary-connection.el @@ -85,31 +85,29 @@ nil: argument is no connection object 'up: connection is open and buffer is existing 'down: connection is closed 'alone: connection is not associated with a buffer" - (if (dictionary-connection-p connection) - (let ((process (dictionary-connection-process connection)) - (buffer (dictionary-connection-buffer connection))) - (if (not process) - 'none - (if (not (buffer-live-p buffer)) - 'alone - (if (not (eq (process-status process) 'open)) - 'down - 'up)))) - nil)) + (when (dictionary-connection-p connection) + (let ((process (dictionary-connection-process connection)) + (buffer (dictionary-connection-buffer connection))) + (if (not process) + 'none + (if (not (buffer-live-p buffer)) + 'alone + (if (not (eq (process-status process) 'open)) + 'down + 'up)))))) (defun dictionary-connection-close (connection) "Force closing of the connection." - (if (dictionary-connection-p connection) - (progn - (let ((buffer (dictionary-connection-buffer connection)) - (process (dictionary-connection-process connection))) - (if process - (delete-process process)) - (if buffer - (kill-buffer buffer)) - - (dictionary-connection-set-process connection nil) - (dictionary-connection-set-buffer connection nil))))) + (when (dictionary-connection-p connection) + (let ((buffer (dictionary-connection-buffer connection)) + (process (dictionary-connection-process connection))) + (if process + (delete-process process)) + (if buffer + (kill-buffer buffer)) + + (dictionary-connection-set-process connection nil) + (dictionary-connection-set-buffer connection nil)))) (defun dictionary-connection-send (connection data) "Send `data' to the process." commit d30618cbc11fb33a0d55c54200eb45f39251189c Author: Torsten Hilbrich Date: Mon Dec 14 09:40:33 2020 +0100 * lisp/net/dictionary.el (dictionary-tooltip-mode): Use setq-local diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 1596e11ce4..afa4d393c0 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -1297,11 +1297,9 @@ overwrite that mode for the current buffer. (let ((on (if arg (> (prefix-numeric-value arg) 0) (not dictionary-tooltip-mode)))) - (make-local-variable 'dictionary-tooltip-mode) - (setq dictionary-tooltip-mode on) - (make-local-variable 'track-mouse) + (setq-local dictionary-tooltip-mode on) + (setq-local track-mouse on) (make-local-variable 'dictionary-tooltip-mouse-event) - (setq track-mouse on) (dictionary-switch-tooltip-mode 1) (if on (local-set-key [mouse-movement] 'dictionary-tooltip-track-mouse) commit 4deb8618e4ab568c01da7c839dff4f29710a3298 Author: Torsten Hilbrich Date: Mon Dec 14 09:40:33 2020 +0100 * lisp/net/dictionary.el (dictionary-mode): Use setq-local diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 782282c27c..1596e11ce4 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -380,10 +380,8 @@ is utf-8" (setq major-mode 'dictionary-mode) (setq mode-name "Dictionary") - (make-local-variable 'dictionary-data-stack) - (setq dictionary-data-stack nil) - (make-local-variable 'dictionary-position-stack) - (setq dictionary-position-stack nil) + (setq-local dictionary-data-stack nil) + (setq-local dictionary-position-stack nil) (make-local-variable 'dictionary-current-data) (make-local-variable 'dictionary-positions) @@ -407,10 +405,8 @@ is utf-8" (switch-to-buffer-other-window buffer) (dictionary-mode) - (make-local-variable 'dictionary-window-configuration) - (make-local-variable 'dictionary-selected-window) - (setq dictionary-window-configuration window-configuration) - (setq dictionary-selected-window selected-window) + (setq-local dictionary-window-configuration window-configuration) + (setq-local dictionary-selected-window selected-window) (dictionary-check-connection) (dictionary-new-buffer) (dictionary-store-positions) commit ffa7d6671d893de397cb17c7230f68ef46bef294 Author: Torsten Hilbrich Date: Mon Dec 14 09:34:44 2020 +0100 * lisp/net/dictionary.el: Prefer defsubst over defmacro diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 624c1a40f5..782282c27c 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -422,17 +422,17 @@ is utf-8" (dictionary-pre-buffer) (dictionary-post-buffer)) -(defmacro dictionary-reply-code (reply) +(defsubst dictionary-reply-code (reply) "Return the reply code stored in `reply'." - (list 'get reply ''reply-code)) + (get reply 'reply-code)) -(defmacro dictionary-reply (reply) +(defsubst dictionary-reply (reply) "Return the string reply stored in `reply'." - (list 'get reply ''reply)) + (get reply 'reply)) -(defmacro dictionary-reply-list (reply) +(defsubst dictionary-reply-list (reply) "Return the reply list stored in `reply'." - (list 'get reply ''reply-list)) + (get reply 'reply-list)) (defun dictionary-open-server (server) "Opens a new connection to this server" commit a557a103cc576c97a82346760a84947fe296000c Author: Torsten Hilbrich Date: Mon Dec 14 09:31:28 2020 +0100 * lisp/net/dictionary-connection.el: Prefer defsubst Use defsubst instead of defmacro here. It was suggested by Stefan Kangas to replace the defmacro here and, looking at the lispref, defsubst seems to be a suitable replacement providing the same benefit of inlining functionality as the defmacro. diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el index f8a667991a..c762b352b7 100644 --- a/lisp/net/dictionary-connection.el +++ b/lisp/net/dictionary-connection.el @@ -27,33 +27,33 @@ ;;; Code: -(defmacro dictionary-connection-p (connection) +(defsubst dictionary-connection-p (connection) "Returns non-nil if `connection' is a connection object" - (list 'get connection ''connection)) + (get connection 'connection)) -(defmacro dictionary-connection-read-point (connection) +(defsubst dictionary-connection-read-point (connection) "Return the read point of the connection object." - (list 'get connection ''dictionary-connection-read-point)) + (get connection 'dictionary-connection-read-point)) -(defmacro dictionary-connection-process (connection) +(defsubst dictionary-connection-process (connection) "Return the process of the connection object." - (list 'get connection ''dictionary-connection-process)) + (get connection 'dictionary-connection-process)) -(defmacro dictionary-connection-buffer (connection) +(defsubst dictionary-connection-buffer (connection) "Return the buffer of the connection object." - (list 'get connection ''dictionary-connection-buffer)) + (get connection 'dictionary-connection-buffer)) -(defmacro dictionary-connection-set-read-point (connection point) +(defsubst dictionary-connection-set-read-point (connection point) "Set the read-point for `connection' to `point'." - (list 'put connection ''dictionary-connection-read-point point)) + (put connection 'dictionary-connection-read-point point)) -(defmacro dictionary-connection-set-process (connection process) +(defsubst dictionary-connection-set-process (connection process) "Set the process for `connection' to `process'." - (list 'put connection ''dictionary-connection-process process)) + (put connection 'dictionary-connection-process process)) -(defmacro dictionary-connection-set-buffer (connection buffer) +(defsubst dictionary-connection-set-buffer (connection buffer) "Set the buffer for `connection' to `buffer'." - (list 'put connection ''dictionary-connection-buffer buffer)) + (put connection 'dictionary-connection-buffer buffer)) (defun dictionary-connection-create-data (buffer process point) "Create a new connection data based on `buffer', `process', and `point'." commit 54a3964e290d277df1e510c8829ede926aac23b2 Author: Torsten Hilbrich Date: Thu Nov 19 21:50:50 2020 +0100 Update GPL version * lisp/net/dictionary.el: Use GPL version 3 or later * lisp/net/dictionary-connection.el: Use GPL version 3 or later diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el index a5c36e65b4..f8a667991a 100644 --- a/lisp/net/dictionary-connection.el +++ b/lisp/net/dictionary-connection.el @@ -5,7 +5,7 @@ ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index d910dab160..624c1a40f5 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -5,7 +5,7 @@ ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, commit f58443780cec26bad578309ae7c801baaa1b07db Author: Torsten Hilbrich Date: Thu Nov 19 21:49:18 2020 +0100 * lisp/net/dictionary-connection.el: Remove obsolete Version diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el index d433fb3fec..a5c36e65b4 100644 --- a/lisp/net/dictionary-connection.el +++ b/lisp/net/dictionary-connection.el @@ -2,7 +2,6 @@ ;; Author: Torsten Hilbrich ;; Keywords: network -;; Version: 1.11 ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by commit 0044a2e888a62eea6dd8e6ead5aeffec965bf3a3 Author: Torsten Hilbrich Date: Thu Nov 19 21:48:29 2020 +0100 * lisp/net/dictionary-connection.el: Add lexical-binding:t diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el index f1d11bf3c5..d433fb3fec 100644 --- a/lisp/net/dictionary-connection.el +++ b/lisp/net/dictionary-connection.el @@ -1,4 +1,4 @@ -;;; dictionary-connection.el --- TCP-based client connection for dictionary +;;; dictionary-connection.el --- TCP-based client connection for dictionary -*- lexical-binding:t -*- ;; Author: Torsten Hilbrich ;; Keywords: network commit 81ebe86d8deace5cc39979a42dcf062bdaa830c4 Author: Torsten Hilbrich Date: Thu Nov 19 21:45:25 2020 +0100 Show error message when asking to match for nothing * lisp/net/dictionary.el (dictionary-popup-matching-words): Show error if neither the parameter nor the word at point are defined This avoids an error later on when the nil value is used as string within dictionary-encode-charset. diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 12b11cb511..d910dab160 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -1179,7 +1179,7 @@ It presents the word at point as default input and allows editing it." (defun dictionary-popup-matching-words (&optional word) "Display entries matching the word at the point" (interactive) - (dictionary-do-matching (or word (current-word)) + (dictionary-do-matching (or word (current-word) (error "Nothing to search for")) dictionary-default-dictionary dictionary-default-popup-strategy 'dictionary-process-popup-replies)) commit 09952ce43451b76a0f7839e35d033fbbfa078e31 Author: Torsten Hilbrich Date: Thu Nov 19 21:40:45 2020 +0100 Removed useless check for popup-menu * lisp/net/dictionary.el (dictionary-popup-matching-words): No need to check for popup-menu, the code is part of Emacs now and the function should always be there diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 65ed7d2b1e..12b11cb511 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -1179,8 +1179,6 @@ It presents the word at point as default input and allows editing it." (defun dictionary-popup-matching-words (&optional word) "Display entries matching the word at the point" (interactive) - (unless (functionp 'popup-menu) - (error "Sorry, popup menus are not available in this emacs version")) (dictionary-do-matching (or word (current-word)) dictionary-default-dictionary dictionary-default-popup-strategy commit cc5f2803785c5dc785f09a292313cf799e8d29bb Author: Torsten Hilbrich Date: Thu Nov 19 21:39:10 2020 +0100 * lisp/net/dictionary.el: Add lexical-binding:t Fixing all the issues found by this. A number of unused variables were reported here. diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 6eb8475f55..65ed7d2b1e 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -1,4 +1,4 @@ -;;; dictionary.el --- Client for rfc2229 dictionary servers +;;; dictionary.el --- Client for rfc2229 dictionary servers -*- lexical-binding:t -*- ;; Author: Torsten Hilbrich ;; Keywords: interface, dictionary @@ -416,7 +416,7 @@ is utf-8" (dictionary-store-positions) (dictionary-store-state 'dictionary-new-buffer nil))) -(defun dictionary-new-buffer (&rest ignore) +(defun dictionary-new-buffer () "Create a new and clean buffer" (dictionary-pre-buffer) @@ -513,7 +513,7 @@ is utf-8" ;; Dealing with closing the buffer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun dictionary-close (&rest ignore) +(defun dictionary-close () "Close the current dictionary buffer and its connection" (interactive) (if (eq major-mode 'dictionary-mode) @@ -777,13 +777,13 @@ This function knows about the special meaning of quotes (\")" (dictionary (nth 2 reply-list)) (description (nth 3 reply-list)) (word (nth 1 reply-list))) - (dictionary-display-word-entry word dictionary description) + (dictionary-display-word-entry dictionary description) (setq reply (dictionary-read-answer)) (dictionary-display-word-definition reply word dictionary) (setq reply (dictionary-read-reply-and-split)))) (dictionary-post-buffer))) -(defun dictionary-display-word-entry (word dictionary description) +(defun dictionary-display-word-entry (dictionary description) "Insert an explanation for the current definition." (let ((start (point))) (insert "From " @@ -857,7 +857,7 @@ The word is taken from the buffer, the `dictionary' is given as argument." (unless (dictionary-check-reply reply 110) (error "Unknown server answer: %s" (dictionary-reply reply))) - (dictionary-display-dictionarys reply)))) + (dictionary-display-dictionarys)))) (defun dictionary-simple-split-string (string &optional pattern) "Return a list of substrings of STRING which are separated by PATTERN. @@ -872,7 +872,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." start (match-end 0))) (nreverse (cons (substring string start) parts)))) -(defun dictionary-display-dictionarys (reply) +(defun dictionary-display-dictionarys () "Handle the display of all dictionaries existing on the server" (dictionary-pre-buffer) (insert "Please select your default dictionary:\n\n") @@ -969,9 +969,9 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (unless (dictionary-check-reply reply 111) (error "Unknown server answer: %s" (dictionary-reply reply))) - (dictionary-display-strategies reply)))) + (dictionary-display-strategies)))) -(defun dictionary-display-strategies (reply) +(defun dictionary-display-strategies () "Handle the display of all strategies existing on the server" (dictionary-pre-buffer) (insert "Please select your default search strategy:\n\n") @@ -1186,9 +1186,8 @@ It presents the word at point as default input and allows editing it." dictionary-default-popup-strategy 'dictionary-process-popup-replies)) -(defun dictionary-process-popup-replies (reply) - (let ((number (nth 1 (dictionary-reply-list reply))) - (list (dictionary-simple-split-string (dictionary-read-answer) "\n+"))) +(defun dictionary-process-popup-replies (&ignore) + (let ((list (dictionary-simple-split-string (dictionary-read-answer) "\n+"))) (let ((result (mapcar (lambda (item) (let* ((list (dictionary-split-string item)) @@ -1204,13 +1203,11 @@ It presents the word at point as default input and allows editing it." t )))) list))) - (let ((menu (make-sparse-keymap 'dictionary-popup))) - - (easy-menu-define dictionary-mode-map-menu dictionary-mode-map - "Menu used for displaying dictionary popup" - (cons "Matching words" - `(,@result))) - (popup-menu dictionary-mode-map-menu))))) + (easy-menu-define dictionary-mode-map-menu dictionary-mode-map + "Menu used for displaying dictionary popup" + (cons "Matching words" + `(,@result))) + (popup-menu dictionary-mode-map-menu)))) ;;; Tooltip support @@ -1234,7 +1231,7 @@ It presents the word at point as default input and allows editing it." (dictionary-do-search word dictionary 'dictionary-read-definition t)) nil)) -(defun dictionary-read-definition (reply) +(defun dictionary-read-definition (&ignore) (let ((list (dictionary-simple-split-string (dictionary-read-answer) "\n+"))) (mapconcat 'identity (cdr list) "\n"))) @@ -1255,7 +1252,7 @@ It presents the word at point as default input and allows editing it." (defvar dictionary-tooltip-mouse-event nil "Event that triggered the tooltip mode") -(defun dictionary-display-tooltip (event) +(defun dictionary-display-tooltip (&ignore) "Search the current word in the `dictionary-tooltip-dictionary'." (interactive "e") (if (and dictionary-tooltip-mode dictionary-tooltip-dictionary) commit d5a4da25b03d9af850077cf803b8099a4056152c Author: Torsten Hilbrich Date: Thu Nov 19 21:21:43 2020 +0100 * lisp/net/dictionary.el: Remove remnants of package Version and package depedencies are not useful when included into Emacs. diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 510a905aca..6eb8475f55 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -2,8 +2,6 @@ ;; Author: Torsten Hilbrich ;; Keywords: interface, dictionary -;; Version: 1.11 -;; Package-Requires: ((connection "1.11") (link "1.11")) ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by commit 7ca331a4f94a6a5f9c454823fd5c765031ce7167 Author: Matthias Meulien Date: Sun Nov 8 16:08:07 2020 +0100 Add history of search words to read-string diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 0682d5511c..510a905aca 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -344,6 +344,10 @@ is utf-8" (error nil)) "Determines if the Emacs has support to display color") +(defvar dictionary-word-history + '() + "History list of searched word") + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Basic function providing startup actions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1118,7 +1122,7 @@ It presents the word at point as default input and allows editing it." (read-string (if default (format "Search word (%s): " default) "Search word: ") - nil nil default)) + nil 'dictionary-word-history default)) (if current-prefix-arg (read-string (if dictionary-default-dictionary (format "Dictionary (%s): " dictionary-default-dictionary) @@ -1128,7 +1132,7 @@ It presents the word at point as default input and allows editing it." ;; if called by pressing the button (unless word - (setq word (read-string "Search word: "))) + (setq word (read-string "Search word: " nil 'dictionary-word-history))) ;; just in case non-interactivly called (unless dictionary (setq dictionary dictionary-default-dictionary)) @@ -1158,7 +1162,8 @@ It presents the word at point as default input and allows editing it." (interactive) ;; can't use interactive because of mouse events (or pattern - (setq pattern (read-string "Search pattern: "))) + (setq pattern (read-string "Search pattern: " + nil 'dictionary-word-history))) (dictionary-new-matching pattern)) ;;;###autoload commit 28fe1349711e36bd65542472cd3fb0d94c5e2bb2 Author: Matthias Meulien Date: Sun Nov 8 16:06:02 2020 +0100 Remove text property from empty line diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 1e1d4d9d44..0682d5511c 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -788,9 +788,9 @@ This function knows about the special meaning of quotes (\")" dictionary-description-open-delimiter (dictionary-decode-charset description dictionary) dictionary-description-close-delimiter - " [" (dictionary-decode-charset dictionary dictionary) "]:" - "\n\n") - (put-text-property start (point) 'face 'dictionary-word-entry-face))) + " [" (dictionary-decode-charset dictionary dictionary) "]:") + (put-text-property start (point) 'face 'dictionary-word-entry-face) + (insert "\n\n"))) (defun dictionary-display-word-definition (reply word dictionary) "Insert the definition for the current word" commit 91ff1c8f7cf5b137b214b0b70a7267d34c1f6b36 Author: Torsten Hilbrich Date: Thu Nov 19 08:25:42 2020 +0100 Move placement of dictionary-tooltip-mouse-event * lisp/net/dictionary.el (dictionary-tooltip-mouse-event): Place variable before dictionary-display-tooltip to avoid warning about use of free variable when compiling dictionary-display-tooltip diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index a1d4ac9214..1e1d4d9d44 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -1249,6 +1249,9 @@ It presents the word at point as default input and allows editing it." (goto-char point) (current-word)))))) +(defvar dictionary-tooltip-mouse-event nil + "Event that triggered the tooltip mode") + (defun dictionary-display-tooltip (event) "Search the current word in the `dictionary-tooltip-dictionary'." (interactive "e") @@ -1263,9 +1266,6 @@ It presents the word at point as default input and allows editing it." t) nil)) -(defvar dictionary-tooltip-mouse-event nil - "Event that triggered the tooltip mode") - (defun dictionary-tooltip-track-mouse (event) "Called whenever a dictionary tooltip display is about to be triggered." (interactive "e") commit 2f1e4fbc426624420159026b758c90a923a9b560 Author: Torsten Hilbrich Date: Thu Nov 19 08:23:07 2020 +0100 Support nil value for dictionary-server * net/lisp/dictionary.el (dictionary-server): Support choice to select the dictionary server to use * net/lisp/dictionary.el (dictionary-check-connection): Support nil value for dictionary-server This nil value is the new default value of that variable. When opening a new connection and dictionary-server is nil the code behaves the following way: - it will first try to connect to a dictd server running on localhost - if that fails, it queries the user if the alternative server (dict.org) should be consulted - if the user agrees, the connection is made to dict.org This allows the default value of dictionary-server not to connect a remote server by default. The user is always able to select a different server by customizing the variable dictionary-search. diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 8d7d97afe0..a1d4ac9214 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -44,13 +44,13 @@ ;; Stuff for customizing. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar dictionary-server) +(defvar dictionary-current-server) (defun dictionary-set-server-var (name value) (if (and (boundp 'dictionary-connection) dictionary-connection (eq (dictionary-connection-status dictionary-connection) 'up) (y-or-n-p - (concat "Close existing connection to " dictionary-server "? "))) + (concat "Close existing connection to " dictionary-current-server "? "))) (dictionary-connection-close dictionary-connection)) (set-default name value)) @@ -63,11 +63,22 @@ :group 'dictionary) (defcustom dictionary-server - "dict.org" - "This server is contacted for searching the dictionary" + nil + "This server is contacted for searching the dictionary. + +You can specify here: + +- Automatic: First try localhost, then dict.org after confirmation +- localhost: Only use localhost +- dict.org: Only use dict.org +- User-defined: You can specify your own server here +" :group 'dictionary :set 'dictionary-set-server-var - :type 'string + :type '(choice (const :tag "Automatic" nil) + (const :tag "localhost" "localhost") + (const :tag "dict.org" "dict.org") + (string :tag "User-defined")) :version "28.1") (defcustom dictionary-port @@ -421,56 +432,71 @@ is utf-8" "Return the reply list stored in `reply'." (list 'get reply ''reply-list)) +(defun dictionary-open-server (server) + "Opens a new connection to this server" + (let ((wanted 'raw-text) + (coding-system nil)) + (if (member wanted (coding-system-list)) + (setq coding-system wanted)) + (let ((coding-system-for-read coding-system) + (coding-system-for-write coding-system)) + (setq dictionary-current-server server) + (message "Opening connection to %s:%s" server + dictionary-port) + (dictionary-connection-close dictionary-connection) + (setq dictionary-connection + (if dictionary-use-http-proxy + (dictionary-connection-open dictionary-proxy-server + dictionary-proxy-port) + (dictionary-connection-open server dictionary-port))) + (set-process-query-on-exit-flag + (dictionary-connection-process dictionary-connection) + nil) + + (when dictionary-use-http-proxy + (message "Proxy CONNECT to %s:%d" + dictionary-proxy-server + dictionary-proxy-port) + (dictionary-send-command (format "CONNECT %s:%d HTTP/1.1" + server + dictionary-port)) + ;; just a \r\n combination + (dictionary-send-command "") + + ;; read first line of reply + (let* ((reply (dictionary-read-reply)) + (reply-list (dictionary-split-string reply))) + ;; first item is protocol, second item is code + (unless (= (string-to-number (cadr reply-list)) 200) + (error "Bad reply from proxy server %s" reply)) + + ;; skip the following header lines until empty found + (while (not (equal reply "")) + (setq reply (dictionary-read-reply))))) + + (dictionary-check-initial-reply) + (dictionary-send-command (concat "client " dictionary-identification)) + (let ((reply (dictionary-read-reply-and-split))) + (message nil) + (unless (dictionary-check-reply reply 250) + (error "Unknown server answer: %s" + (dictionary-reply reply))))))) + (defun dictionary-check-connection () "Check if there is already a connection open" (if (not (and dictionary-connection (eq (dictionary-connection-status dictionary-connection) 'up))) - (let ((wanted 'raw-text) - (coding-system nil)) - (if (member wanted (coding-system-list)) - (setq coding-system wanted)) - (let ((coding-system-for-read coding-system) - (coding-system-for-write coding-system)) - (message "Opening connection to %s:%s" dictionary-server - dictionary-port) - (dictionary-connection-close dictionary-connection) - (setq dictionary-connection - (if dictionary-use-http-proxy - (dictionary-connection-open dictionary-proxy-server - dictionary-proxy-port) - (dictionary-connection-open dictionary-server dictionary-port))) - (set-process-query-on-exit-flag - (dictionary-connection-process dictionary-connection) - nil) - - (when dictionary-use-http-proxy - (message "Proxy CONNECT to %s:%d" - dictionary-proxy-server - dictionary-proxy-port) - (dictionary-send-command (format "CONNECT %s:%d HTTP/1.1" - dictionary-server - dictionary-port)) - ;; just a \r\n combination - (dictionary-send-command "") - - ;; read first line of reply - (let* ((reply (dictionary-read-reply)) - (reply-list (dictionary-split-string reply))) - ;; first item is protocol, second item is code - (unless (= (string-to-number (cadr reply-list)) 200) - (error "Bad reply from proxy server %s" reply)) - - ;; skip the following header lines until empty found - (while (not (equal reply "")) - (setq reply (dictionary-read-reply))))) - - (dictionary-check-initial-reply) - (dictionary-send-command (concat "client " dictionary-identification)) - (let ((reply (dictionary-read-reply-and-split))) - (message nil) - (unless (dictionary-check-reply reply 250) - (error "Unknown server answer: %s" - (dictionary-reply reply)))))))) + (if dictionary-server + (dictionary-open-server dictionary-server) + (let ((server "localhost")) + (condition-case nil + (dictionary-open-server server) + (error + (if (y-or-n-p + (format "Failed to open server %s, continue with dict.org?" + server)) + (dictionary-open-server "dict.org") + (error "Failed automatic server selection, please customize dictionary-server")))))))) (defun dictionary-mode-p () "Return non-nil if current buffer has dictionary-mode" commit 837505075c942183cac004cb8fa0c0e57c82535d Author: Torsten Hilbrich Date: Sat Oct 10 07:04:27 2020 +0200 Fix dictionary tooltip mode * lisp/net/dicionary.el (dictionary-tooltip-mode): Add mouse movement binding and use tooltip-functions instead of tooltip-hook There were some changes in Emacs since testing it the last time. I had to add keybinding for mouse movement and enable track-mouse to get the mode working again. diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index c852f6cfdc..8d7d97afe0 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -1209,30 +1209,69 @@ It presents the word at point as default input and allows editing it." (let ((list (dictionary-simple-split-string (dictionary-read-answer) "\n+"))) (mapconcat 'identity (cdr list) "\n"))) +;;; Tooltip support for GNU Emacs (defvar global-dictionary-tooltip-mode nil) -;;; Tooltip support for GNU Emacs +(defun dictionary-word-at-mouse-event (event) + (with-current-buffer (tooltip-event-buffer event) + (let ((point (posn-point (event-end event)))) + (if (use-region-p) + (when (and (<= (region-beginning) point) (<= point (region-end))) + (buffer-substring (region-beginning) (region-end))) + (save-excursion + (goto-char point) + (current-word)))))) + (defun dictionary-display-tooltip (event) "Search the current word in the `dictionary-tooltip-dictionary'." (interactive "e") - (if dictionary-tooltip-dictionary - (let ((word (save-window-excursion - (save-excursion - (mouse-set-point event) - (current-word))))) - (let ((definition - (dictionary-definition word dictionary-tooltip-dictionary))) - (if definition - (tooltip-show - (dictionary-decode-charset definition - dictionary-tooltip-dictionary))) - t)) + (if (and dictionary-tooltip-mode dictionary-tooltip-dictionary) + (let ((word (dictionary-word-at-mouse-event dictionary-tooltip-mouse-event))) + (if word + (let ((definition + (dictionary-definition word dictionary-tooltip-dictionary))) + (if definition + (tooltip-show (dictionary-decode-charset definition + dictionary-tooltip-dictionary))))) + t) nil)) +(defvar dictionary-tooltip-mouse-event nil + "Event that triggered the tooltip mode") + +(defun dictionary-tooltip-track-mouse (event) + "Called whenever a dictionary tooltip display is about to be triggered." + (interactive "e") + (tooltip-hide) + (when dictionary-tooltip-mode + (setq dictionary-tooltip-mouse-event (copy-sequence event)) + (tooltip-start-delayed-tip))) + +(defun dictionary-switch-tooltip-mode (on) + "Turn off or on support for the dictionary tooltip mode. + +It is normally internally called with 1 to enable support for the +tooltip mode. The hook function will check the value of the +variable dictionary-tooltip-mode to decide if some action must be +taken. When disabling the tooltip mode the value of this variable +will be set to nil. +" + (interactive) + (tooltip-mode on) + (if on + (add-hook 'tooltip-functions 'dictionary-display-tooltip) + (remove-hook 'tooltip-functions 'dictionary-display-tooltip))) + ;;;###autoload (defun dictionary-tooltip-mode (&optional arg) - "Display tooltips for the current word" + "Display tooltips for the current word. + +This function can be used to enable or disable the tooltip mode +for the current buffer. If global-tooltip-mode is active it will +overwrite that mode for the current buffer. +" + (interactive "P") (require 'tooltip) (let ((on (if arg @@ -1240,26 +1279,38 @@ It presents the word at point as default input and allows editing it." (not dictionary-tooltip-mode)))) (make-local-variable 'dictionary-tooltip-mode) (setq dictionary-tooltip-mode on) - ;; make sure that tooltip is still (global available) even is on - ;; if nil - (tooltip-mode 1) - (add-hook 'tooltip-hook 'dictionary-display-tooltip) (make-local-variable 'track-mouse) - (setq track-mouse on))) + (make-local-variable 'dictionary-tooltip-mouse-event) + (setq track-mouse on) + (dictionary-switch-tooltip-mode 1) + (if on + (local-set-key [mouse-movement] 'dictionary-tooltip-track-mouse) + (local-set-key [mouse-movement] 'ignore)) + on)) ;;;###autoload (defun global-dictionary-tooltip-mode (&optional arg) - "Enable/disable dictionary-tooltip-mode for all buffers" + "Enable/disable dictionary-tooltip-mode for all buffers. + +Internally it provides a default for the dictionary-tooltip-mode. +It can be overwritten for each buffer using dictionary-tooltip-mode. + +Note: (global-dictionary-tooltip-mode 0) will not disable the mode +any buffer where (dictionary-tooltip-mode 1) has been called. +" (interactive "P") (require 'tooltip) - (let* ((on (if arg (> (prefix-numeric-value arg) 0) - (not global-dictionary-tooltip-mode))) - (hook-fn (if on 'add-hook 'remove-hook))) + (let ((on (if arg (> (prefix-numeric-value arg) 0) + (not global-dictionary-tooltip-mode)))) (setq global-dictionary-tooltip-mode on) - (tooltip-mode 1) - (funcall hook-fn 'tooltip-hook 'dictionary-display-tooltip) (setq-default dictionary-tooltip-mode on) - (setq-default track-mouse on))) + (make-local-variable 'dictionary-tooltip-mouse-event) + (setq-default track-mouse on) + (dictionary-switch-tooltip-mode 1) + (if on + (global-set-key [mouse-movement] 'dictionary-tooltip-track-mouse) + (global-set-key [mouse-movement] 'ignore)) + on)) (provide 'dictionary) ;;; dictionary.el ends here commit 329b6a0210f28d8abf8a8ce7afa6a7a6d3f84977 Author: Torsten Hilbrich Date: Fri Oct 9 06:04:35 2020 +0200 Adding details page for dictionary * net/lisp/dictionary.el (dictionary-display-dictionary-line): Allow getting more details on a dictionary by clicking the "(Details)" link. I had the functionality to query the dictionary information but no mechanism to invoke it. So just add a button after the short description of the dictionary to get more information. diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index b25dda5c69..c852f6cfdc 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -680,8 +680,13 @@ This function knows about the special meaning of quotes (\")" (define-button-type 'dictionary-link 'face 'dictionary-reference-face - 'action (lambda (button) (funcall (button-get button 'callback) - (button-get button 'data)))) + 'action (lambda (button) + (let ((func (button-get button 'callback)) + (data (button-get button 'data)) + (list-data (button-get button 'list-data))) + (if list-data + (apply func list-data) + (funcall func data))))) (define-button-type 'dictionary-button :supertype 'dictionary-link @@ -863,6 +868,12 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." 'callback 'dictionary-set-dictionary 'data (cons dictionary description) 'help-echo (purecopy "Mouse-2 to select this dictionary")) + (unless (dictionary-special-dictionary dictionary) + (insert " ") + (insert-button "(Details)" :type 'dictionary-link + 'callback 'dictionary-set-dictionary + 'list-data (list (cons dictionary description) t) + 'help-echo (purecopy "Mouse-2 to get more information"))) (insert "\n"))))) (defun dictionary-set-dictionary (param &optional more) @@ -875,13 +886,17 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (dictionary-restore-state) (message "Dictionary %s has been selected" dictionary)))) +(defun dictionary-special-dictionary (name) + "Checks whether the special * or ! dictionary are seen" + (or (equal name "*") + (equal name "!"))) + (defun dictionary-display-more-info (param) "Display the available information on the dictionary" (let ((dictionary (car param)) (description (cdr param))) - (unless (or (equal dictionary "*") - (equal dictionary "!")) + (unless (dictionary-special-dictionary dictionary) (dictionary-store-positions) (message "Requesting more information on %s" dictionary) (dictionary-send-command @@ -1048,7 +1063,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (mapc (lambda (word) (setq word (dictionary-decode-charset word dictionary)) (insert " ") - (insert-button word :type 'dictionary-button + (insert-button word :type 'dictionary-link 'callback 'dictionary-new-search 'data (cons word dictionary) 'help-echo (purecopy "Mouse-2 to lookup word")) commit 1773b9b68742c95b1648a90c56eb7b56c77db591 Author: Torsten Hilbrich Date: Fri Oct 9 05:00:02 2020 +0200 Dictionary now uses button * net/lisp/dictionary-link.el: Removed now obsolete file * net/lisp/dictionary.el: Use insert-button and make-button * net/lisp/dictionary.el (dictionary-mode-map): Now defined using defvar I had to add a conversion function as parameter for the button 'action as I need to be able to pass nil data to my function. This is not possible with the regular button 'action function and the 'button-data value. The functionality of searching a link in all dictionaries has been removed for now. It might appear again once I have an idea how to implement it. diff --git a/lisp/net/dictionary-link.el b/lisp/net/dictionary-link.el deleted file mode 100644 index 549f199e02..0000000000 --- a/lisp/net/dictionary-link.el +++ /dev/null @@ -1,122 +0,0 @@ -;;; dictionary-link.el --- Hypertext links in text buffers - -;; Author: Torsten Hilbrich -;; Keywords: interface, hypermedia -;; Version: 1.11 - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This file contains functions for using links in buffers. A link is -;; a part of the buffer marked with a special face, beeing -;; hightlighted while the mouse points to it and beeing activated when -;; pressing return or clicking the button2. - -;; Which each link a function and some data are associated. Upon -;; clicking the function is called with the data as only -;; argument. Both the function and the data are stored in text -;; properties. -;; -;; dictionary-link-create-link - insert a new link for the text in the given range -;; dictionary-link-initialize-keymap - install the keybinding for selecting links - -;;; Code: - -(defun dictionary-link-create-link (start end face function &optional data help) - "Create a link in the current buffer starting from `start' going to `end'. -The `face' is used for displaying, the `data' are stored together with the -link. Upon clicking the `function' is called with `data' as argument." - (let ((properties `(face ,face - mouse-face highlight - link t - link-data ,data - help-echo ,help - link-function ,function))) - (remove-text-properties start end properties) - (add-text-properties start end properties))) - -(defun dictionary-link-insert-link (text face function &optional data help) - "Insert the `text' at point to be formatted as link. -The `face' is used for displaying, the `data' are stored together with the -link. Upon clicking the `function' is called with `data' as argument." - (let ((start (point))) - (insert text) - (dictionary-link-create-link start (point) face function data help))) - -(defun dictionary-link-selected (&optional all) - "Is called upon clicking or otherwise visiting the link." - (interactive) - - (let* ((properties (text-properties-at (point))) - (function (plist-get properties 'link-function)) - (data (plist-get properties 'link-data))) - (if function - (funcall function data all)))) - -(defun dictionary-link-selected-all () - "Called for meta clicking the link" - (interactive) - (dictionary-link-selected 'all)) - -(defun dictionary-link-mouse-click (event &optional all) - "Is called upon clicking the link." - (interactive "@e") - - (mouse-set-point event) - (dictionary-link-selected)) - -(defun dictionary-link-mouse-click-all (event) - "Is called upon meta clicking the link." - (interactive "@e") - - (mouse-set-point event) - (dictionary-link-selected-all)) - -(defun dictionary-link-next-link () - "Return the position of the next link or nil if there is none" - (let* ((pos (point)) - (pos (next-single-property-change pos 'link))) - (if pos - (if (text-property-any pos (min (1+ pos) (point-max)) 'link t) - pos - (next-single-property-change pos 'link)) - nil))) - - -(defun dictionary-link-prev-link () - "Return the position of the previous link or nil if there is none" - (let* ((pos (point)) - (pos (previous-single-property-change pos 'link))) - (if pos - (if (text-property-any pos (1+ pos) 'link t) - pos - (let ((val (previous-single-property-change pos 'link))) - (if val - val - (text-property-any (point-min) (1+ (point-min)) 'link t)))) - nil))) - -(defun dictionary-link-initialize-keymap (keymap) - "Defines the necessary bindings inside keymap" - - (define-key keymap [mouse-2] 'dictionary-link-mouse-click) - (define-key keymap [M-mouse-2] 'dictionary-link-mouse-click-all) - (define-key keymap "\r" 'dictionary-link-selected) - (define-key keymap "\M-\r" 'dictionary-link-selected-all)) - -(provide 'dictionary-link) -;;; dictionary-link.el ends here diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index a0e43b89d9..b25dda5c69 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -38,7 +38,7 @@ (require 'easymenu) (require 'custom) (require 'dictionary-connection) -(require 'dictionary-link) +(require 'button) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Stuff for customizing. @@ -296,8 +296,24 @@ is utf-8" ;; Global variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar dictionary-mode-map - nil - "Keymap for dictionary mode") + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (set-keymap-parent map button-buffer-map) + + (define-key map "q" 'dictionary-close) + (define-key map "h" 'dictionary-help) + (define-key map "s" 'dictionary-search) + (define-key map "d" 'dictionary-lookup-definition) + (define-key map "D" 'dictionary-select-dictionary) + (define-key map "M" 'dictionary-select-strategy) + (define-key map "m" 'dictionary-match-words) + (define-key map "l" 'dictionary-previous) + (define-key map "n" 'forward-button) + (define-key map "p" 'backward-button) + (define-key map " " 'scroll-up) + (define-key map (read-kbd-macro "M-SPC") 'scroll-down) + map) + "Keymap for the dictionary mode.") (defvar dictionary-connection nil @@ -340,7 +356,6 @@ is utf-8" * M select the default search strategy * Return or Button2 visit that link - * M-Return or M-Button2 search the word beneath link in all dictionaries " (unless (eq major-mode 'dictionary-mode) @@ -394,39 +409,6 @@ is utf-8" (dictionary-pre-buffer) (dictionary-post-buffer)) - -(unless dictionary-mode-map - (setq dictionary-mode-map (make-sparse-keymap)) - (suppress-keymap dictionary-mode-map) - - (define-key dictionary-mode-map "q" 'dictionary-close) - (define-key dictionary-mode-map "h" 'dictionary-help) - (define-key dictionary-mode-map "s" 'dictionary-search) - (define-key dictionary-mode-map "d" 'dictionary-lookup-definition) - (define-key dictionary-mode-map "D" 'dictionary-select-dictionary) - (define-key dictionary-mode-map "M" 'dictionary-select-strategy) - (define-key dictionary-mode-map "m" 'dictionary-match-words) - (define-key dictionary-mode-map "l" 'dictionary-previous) - - (if (and (string-match "GNU" (emacs-version)) - (not window-system)) - (define-key dictionary-mode-map [9] 'dictionary-next-link) - (define-key dictionary-mode-map [tab] 'dictionary-next-link)) - - ;; shift-tabs normally is supported on window systems only, but - ;; I do not enforce it - (define-key dictionary-mode-map [(shift tab)] 'dictionary-prev-link) - (define-key dictionary-mode-map "\e\t" 'dictionary-prev-link) - (define-key dictionary-mode-map [backtab] 'dictionary-prev-link) - - (define-key dictionary-mode-map "n" 'dictionary-next-link) - (define-key dictionary-mode-map "p" 'dictionary-prev-link) - - (define-key dictionary-mode-map " " 'scroll-up) - (define-key dictionary-mode-map [(meta space)] 'scroll-down) - - (dictionary-link-initialize-keymap dictionary-mode-map)) - (defmacro dictionary-reply-code (reply) "Return the reply code stored in `reply'." (list 'get reply ''reply-code)) @@ -696,43 +678,48 @@ This function knows about the special meaning of quotes (\")" (error "Unknown server answer: %s" (dictionary-reply reply))) (funcall function reply))))) +(define-button-type 'dictionary-link + 'face 'dictionary-reference-face + 'action (lambda (button) (funcall (button-get button 'callback) + (button-get button 'data)))) + +(define-button-type 'dictionary-button + :supertype 'dictionary-link + 'face 'dictionary-button-face) + (defun dictionary-pre-buffer () "These commands are executed at the begin of a new buffer" (setq buffer-read-only nil) (erase-buffer) (if dictionary-create-buttons (progn - (dictionary-link-insert-link "[Back]" 'dictionary-button-face - 'dictionary-restore-state nil - "Mouse-2 to go backwards in history") + (insert-button "[Back]" :type 'dictionary-button + 'callback 'dictionary-restore-state + 'help-echo (purecopy "Mouse-2 to go backwards in history")) (insert " ") - (dictionary-link-insert-link "[Search Definition]" - 'dictionary-button-face - 'dictionary-search nil - "Mouse-2 to look up a new word") + (insert-button "[Search Definition]" :type 'dictionary-button + 'callback 'dictionary-search + 'help-echo (purecopy "Mouse-2 to look up a new word")) (insert " ") - (dictionary-link-insert-link "[Matching words]" - 'dictionary-button-face - 'dictionary-match-words nil - "Mouse-2 to find matches for a pattern") + (insert-button "[Matching words]" :type 'dictionary-button + 'callback 'dictionary-match-words + 'help-echo (purecopy "Mouse-2 to find matches for a pattern")) (insert " ") - (dictionary-link-insert-link "[Quit]" 'dictionary-button-face - 'dictionary-close nil - "Mouse-2 to close this window") + (insert-button "[Quit]" :type 'dictionary-button + 'callback 'dictionary-close + 'help-echo (purecopy "Mouse-2 to close this window")) (insert "\n ") - (dictionary-link-insert-link "[Select Dictionary]" - 'dictionary-button-face - 'dictionary-select-dictionary nil - "Mouse-2 to select dictionary for future searches") + (insert-button "[Select Dictionary]" :type 'dictionary-button + 'callback 'dictionary-select-dictionary + 'help-echo (purecopy "Mouse-2 to select dictionary for future searches")) (insert " ") - (dictionary-link-insert-link "[Select Match Strategy]" - 'dictionary-button-face - 'dictionary-select-strategy nil - "Mouse-2 to select matching algorithm") + (insert-button "[Select Match Strategy]" :type 'dictionary-button + 'callback 'dictionary-select-strategy + 'help-echo (purecopy "Mouse-2 to select matching algorithm")) (insert "\n\n"))) (setq dictionary-marker (point-marker))) @@ -810,10 +797,11 @@ The word is taken from the buffer, the `dictionary' is given as argument." (setq word (replace-match "" t t word))) (unless (equal word displayed-word) - (dictionary-link-create-link start end 'dictionary-reference-face - call (cons word dictionary) - (concat "Press Mouse-2 to lookup \"" - word "\" in \"" dictionary "\""))))) + (make-button start end :type 'dictionary-link + 'callback call + 'data (cons word dictionary) + 'help-echo (concat "Press Mouse-2 to lookup \"" + word "\" in \"" dictionary "\""))))) (defun dictionary-select-dictionary (&rest ignored) "Save the current state and start a dictionary selection" @@ -871,11 +859,10 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (if dictionary (if (equal dictionary "--exit--") (insert "(end of default search list)\n") - (dictionary-link-insert-link (concat dictionary ": " translated) - 'dictionary-reference-face - 'dictionary-set-dictionary - (cons dictionary description) - "Mouse-2 to select this dictionary") + (insert-button (concat dictionary ": " translated) :type 'dictionary-link + 'callback 'dictionary-set-dictionary + 'data (cons dictionary description) + 'help-echo (purecopy "Mouse-2 to select this dictionary")) (insert "\n"))))) (defun dictionary-set-dictionary (param &optional more) @@ -907,10 +894,10 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (error "Unknown server answer: %s" (dictionary-reply reply))) (dictionary-pre-buffer) (insert "Information on dictionary: ") - (dictionary-link-insert-link description 'dictionary-reference-face - 'dictionary-set-dictionary - (cons dictionary description) - "Mouse-2 to select this dictionary") + (insert-button description :type 'dictionary-link + 'callback 'dictionary-set-dictionary + 'data (cons dictionary description) + 'help-echo (purecopy "Mouse-2 to select this dictionary")) (insert "\n\n") (setq reply (dictionary-read-answer)) (insert reply) @@ -958,9 +945,10 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (description (cadr list))) (if strategy (progn - (dictionary-link-insert-link description 'dictionary-reference-face - 'dictionary-set-strategy strategy - "Mouse-2 to select this matching algorithm") + (insert-button description :type 'dictionary-link + 'callback 'dictionary-set-strategy + 'data strategy + 'help-echo (purecopy "Mouse-2 to select this matching algorithm")) (insert "\n"))))) (defun dictionary-set-strategy (strategy &rest ignored) @@ -1060,11 +1048,10 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (mapc (lambda (word) (setq word (dictionary-decode-charset word dictionary)) (insert " ") - (dictionary-link-insert-link word - 'dictionary-reference-face - 'dictionary-new-search - (cons word dictionary) - "Mouse-2 to lookup word") + (insert-button word :type 'dictionary-button + 'callback 'dictionary-new-search + 'data (cons word dictionary) + 'help-echo (purecopy "Mouse-2 to lookup word")) (insert "\n")) (reverse word-list)) (insert "\n"))) list)) @@ -1119,22 +1106,6 @@ It presents the word at point as default input and allows editing it." (error "Current buffer is no dictionary buffer")) (dictionary-restore-state)) -(defun dictionary-next-link () - "Place the cursor to the next link." - (interactive) - (let ((pos (dictionary-link-next-link))) - (if pos - (goto-char pos) - (error "There is no next link")))) - -(defun dictionary-prev-link () - "Place the cursor to the previous link." - (interactive) - (let ((pos (dictionary-link-prev-link))) - (if pos - (goto-char pos) - (error "There is no previous link")))) - (defun dictionary-help () "Display a little help" (interactive) commit 99a7e918c82c0d5c39a729668ac582a945877900 Author: Torsten Hilbrich Date: Thu Oct 8 19:35:50 2020 +0200 Don't check for existence of defface * lisp/net/dictionary.el: defface has been available in Emacs for quite some time now. No need to check it before using it. diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 6ba1cc2775..a0e43b89d9 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -216,64 +216,53 @@ is utf-8" ))) :version "28.1") -(if (fboundp 'defface) - (progn - - (defface dictionary-word-definition-face - '((((supports (:family "DejaVu Serif"))) - (:family "DejaVu Serif")) - (((type x)) - (:font "Sans Serif")) - (t - (:font "default"))) - "The face that is used for displaying the definition of the word." - :group 'dictionary - :version "28.1") - - (defface dictionary-word-entry-face - '((((type x)) - (:italic t)) - (((type tty) (class color)) - (:foreground "green")) - (t - (:inverse t))) - "The face that is used for displaying the initial word entry line." - :group 'dictionary - :version "28.1") - - (defface dictionary-button-face - '((t - (:bold t))) - "The face that is used for displaying buttons." - :group 'dictionary - :version "28.1") - - (defface dictionary-reference-face - '((((type x) - (class color) - (background dark)) - (:foreground "yellow")) - (((type tty) - (class color) - (background dark)) - (:foreground "cyan")) - (((class color) - (background light)) - (:foreground "blue")) - (t - (:underline t))) - - "The face that is used for displaying a reference word." - :group 'dictionary - :version "28.1") - - ) - - ;; else - (copy-face 'italic 'dictionary-word-entry-face) - (copy-face 'bold 'dictionary-button-face) - (copy-face 'default 'dictionary-reference-face) - (set-face-foreground 'dictionary-reference-face "blue")) +(defface dictionary-word-definition-face +'((((supports (:family "DejaVu Serif"))) + (:family "DejaVu Serif")) + (((type x)) + (:font "Sans Serif")) + (t + (:font "default"))) +"The face that is used for displaying the definition of the word." +:group 'dictionary +:version "28.1") + +(defface dictionary-word-entry-face + '((((type x)) + (:italic t)) + (((type tty) (class color)) + (:foreground "green")) + (t + (:inverse t))) + "The face that is used for displaying the initial word entry line." + :group 'dictionary + :version "28.1") + +(defface dictionary-button-face + '((t + (:bold t))) + "The face that is used for displaying buttons." + :group 'dictionary + :version "28.1") + +(defface dictionary-reference-face + '((((type x) + (class color) + (background dark)) + (:foreground "yellow")) + (((type tty) + (class color) + (background dark)) + (:foreground "cyan")) + (((class color) + (background light)) + (:foreground "blue")) + (t + (:underline t))) + + "The face that is used for displaying a reference word." + :group 'dictionary + :version "28.1") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Buffer local variables for storing the current state commit 49c250b388eac27221caa460a01d4ed43c0b37a6 Author: Torsten Hilbrich Date: Thu Oct 8 19:33:33 2020 +0200 Dont't check coding-system-list for existence * lisp/net/dictionary.el (dictionary-coding-systems-for-dictionaries): Don't check for coding-system-list before using it. It check no longer be necessary. diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 7f4bb2a828..6ba1cc2775 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -200,24 +200,21 @@ by the choice value: :version "28.1") ;; Define only when coding-system-list is available -(when (fboundp 'coding-system-list) - (defcustom dictionary-coding-systems-for-dictionaries - '( ("mueller" . koi8-r)) - "Mapping of dictionaries to coding systems. - Each entry in this list defines the coding system to be used for that - dictionary. The default coding system for all other dictionaries - is utf-8" - :group 'dictionary - :type `(repeat (cons :tag "Association" - (string :tag "Dictionary name") - (choice :tag "Coding system" - :value 'utf-8 - ,@(mapcar (lambda (x) (list 'const x)) - (coding-system-list)) - ))) - :version "28.1") - - ) +(defcustom dictionary-coding-systems-for-dictionaries + '( ("mueller" . koi8-r)) + "Mapping of dictionaries to coding systems. +Each entry in this list defines the coding system to be used for that +dictionary. The default coding system for all other dictionaries +is utf-8" + :group 'dictionary + :type `(repeat (cons :tag "Association" + (string :tag "Dictionary name") + (choice :tag "Coding system" + :value 'utf-8 + ,@(mapcar (lambda (x) (list 'const x)) + (coding-system-list)) + ))) + :version "28.1") (if (fboundp 'defface) (progn @@ -459,8 +456,7 @@ by the choice value: (eq (dictionary-connection-status dictionary-connection) 'up))) (let ((wanted 'raw-text) (coding-system nil)) - (if (and (fboundp 'coding-system-list) - (member wanted (coding-system-list))) + (if (member wanted (coding-system-list)) (setq coding-system wanted)) (let ((coding-system-for-read coding-system) (coding-system-for-write coding-system)) @@ -597,14 +593,13 @@ This function knows about the special meaning of quotes (\")" (defun dictionary-coding-system (dictionary) "Select coding system to use for that dictionary" - (when (boundp 'dictionary-coding-systems-for-dictionaries) - (let ((coding-system - (or (cdr (assoc dictionary - dictionary-coding-systems-for-dictionaries)) - 'utf-8))) - (if (member coding-system (coding-system-list)) - coding-system - nil)))) + (let ((coding-system + (or (cdr (assoc dictionary + dictionary-coding-systems-for-dictionaries)) + 'utf-8))) + (if (member coding-system (coding-system-list)) + coding-system + nil))) (defun dictionary-decode-charset (text dictionary) "Convert the text from the charset defined by the dictionary given." commit 5dc17d73b071aefac3dcfed193a82601c94a98af Author: Torsten Hilbrich Date: Thu Oct 8 19:30:12 2020 +0200 Add :version tag to defcustom statement * lisp/net/dictionary.el: Add :version tag to all defcustom statements Suggested-By: Robert Pluim diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index ef667f1fe3..7f4bb2a828 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -67,7 +67,8 @@ "This server is contacted for searching the dictionary" :group 'dictionary :set 'dictionary-set-server-var - :type 'string) + :type 'string + :version "28.1") (defcustom dictionary-port 2628 @@ -75,13 +76,15 @@ This port is propably always 2628 so there should be no need to modify it." :group 'dictionary :set 'dictionary-set-server-var - :type 'number) + :type 'number + :version "28.1") (defcustom dictionary-identification "dictionary.el emacs lisp dictionary client" "This is the identification string that will be sent to the server." :group 'dictionary - :type 'string) + :type 'string + :version "28.1") (defcustom dictionary-default-dictionary "*" @@ -89,13 +92,15 @@ * and ! have a special meaning, * search all dictionaries, ! search until one dictionary yields matches." :group 'dictionary - :type 'string) + :type 'string + :version "28.1") (defcustom dictionary-default-strategy "." "The default strategy for listing matching words." :group 'dictionary - :type 'string) + :type 'string + :version "28.1") (defcustom dictionary-default-popup-strategy "exact" @@ -132,58 +137,67 @@ by the choice value: :type '(choice (const :tag "Exact match" "exact") (const :tag "Similiar sounding" "soundex") (const :tag "Levenshtein distance one" "lev") - (string :tag "User choice"))) + (string :tag "User choice")) + :version "28.1") (defcustom dictionary-create-buttons t "Create some clickable buttons on top of the window if non-nil." :group 'dictionary - :type 'boolean) + :type 'boolean + :version "28.1") (defcustom dictionary-mode-hook nil "Hook run in dictionary mode buffers." :group 'dictionary - :type 'hook) + :type 'hook + :version "28.1") (defcustom dictionary-use-http-proxy nil "Connects via a HTTP proxy using the CONNECT command when not nil." :group 'dictionary-proxy :set 'dictionary-set-server-var - :type 'boolean) + :type 'boolean + :version "28.1") (defcustom dictionary-proxy-server "proxy" "The name of the HTTP proxy to use when dictionary-use-http-proxy is set." :group 'dictionary-proxy :set 'dictionary-set-server-var - :type 'string) + :type 'string + :version "28.1") (defcustom dictionary-proxy-port 3128 "The port of the proxy server, used only when dictionary-use-http-proxy is set." :group 'dictionary-proxy :set 'dictionary-set-server-var - :type 'number) + :type 'number + :version "28.1") (defcustom dictionary-use-single-buffer nil "Should the dictionary command reuse previous dictionary buffers?" :group 'dictionary - :type 'boolean) + :type 'boolean + :version "28.1") (defcustom dictionary-description-open-delimiter "" "The delimiter to display in front of the dictionaries description" :group 'dictionary - :type 'string) + :type 'string + :version "28.1") (defcustom dictionary-description-close-delimiter "" "The delimiter to display after of the dictionaries description" :group 'dictionary - :type 'string) + :type 'string + :version "28.1") ;; Define only when coding-system-list is available (when (fboundp 'coding-system-list) @@ -200,7 +214,8 @@ by the choice value: :value 'utf-8 ,@(mapcar (lambda (x) (list 'const x)) (coding-system-list)) - )))) + ))) + :version "28.1") ) @@ -215,7 +230,8 @@ by the choice value: (t (:font "default"))) "The face that is used for displaying the definition of the word." - :group 'dictionary) + :group 'dictionary + :version "28.1") (defface dictionary-word-entry-face '((((type x)) @@ -225,13 +241,15 @@ by the choice value: (t (:inverse t))) "The face that is used for displaying the initial word entry line." - :group 'dictionary) + :group 'dictionary + :version "28.1") (defface dictionary-button-face '((t (:bold t))) "The face that is used for displaying buttons." - :group 'dictionary) + :group 'dictionary + :version "28.1") (defface dictionary-reference-face '((((type x) @@ -249,7 +267,8 @@ by the choice value: (:underline t))) "The face that is used for displaying a reference word." - :group 'dictionary) + :group 'dictionary + :version "28.1") ) @@ -1206,7 +1225,8 @@ It presents the word at point as default input and allows editing it." nil "This dictionary to lookup words for tooltips" :group 'dictionary - :type '(choice (const :tag "None" nil) string)) + :type '(choice (const :tag "None" nil) string) + :version "28.1") (defun dictionary-definition (word &optional dictionary) (interactive) commit 723906c4443e4aa8636c0d5bec8645ae1e29f79a Author: Torsten Hilbrich Date: Mon Oct 5 07:06:30 2020 +0200 Removed some compability parts in dictionary * lisp/net/dictionary.el: Use cl-lib, remove defface and defgroup checks, remove xemacs-related code * lisp/net/dictionary-link.el: Remove xemacs-related code diff --git a/lisp/net/dictionary-link.el b/lisp/net/dictionary-link.el index 86e853e64e..549f199e02 100644 --- a/lisp/net/dictionary-link.el +++ b/lisp/net/dictionary-link.el @@ -113,14 +113,10 @@ link. Upon clicking the `function' is called with `data' as argument." (defun dictionary-link-initialize-keymap (keymap) "Defines the necessary bindings inside keymap" - (if (and (boundp 'running-xemacs) running-xemacs) - (progn - (define-key keymap [button2] 'dictionary-link-mouse-click) - (define-key keymap [(meta button2)] 'dictionary-link-mouse-click-all)) - (define-key keymap [mouse-2] 'dictionary-link-mouse-click) - (define-key keymap [M-mouse-2] 'dictionary-link-mouse-click-all)) - (define-key keymap "\r" 'dictionary-link-selected) - (define-key keymap "\M-\r" 'dictionary-link-selected-all)) + (define-key keymap [mouse-2] 'dictionary-link-mouse-click) + (define-key keymap [M-mouse-2] 'dictionary-link-mouse-click-all) + (define-key keymap "\r" 'dictionary-link-selected) + (define-key keymap "\M-\r" 'dictionary-link-selected-all)) (provide 'dictionary-link) ;;; dictionary-link.el ends here diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 4b2f25c26b..ef667f1fe3 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -34,9 +34,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) - +(require 'cl-lib) (require 'easymenu) (require 'custom) (require 'dictionary-connection) @@ -46,16 +44,6 @@ ;; Stuff for customizing. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(eval-when-compile - (unless (fboundp 'defface) - (message "Please update your custom.el file: %s" - "http://www.dina.kvl.dk/~abraham/custom/")) - - (unless (fboundp 'defgroup) - (defmacro defgroup (&rest ignored)) - (defmacro defcustom (var value doc &rest ignored) - (list 'defvar var value doc)))) - (defvar dictionary-server) (defun dictionary-set-server-var (name value) (if (and (boundp 'dictionary-connection) @@ -351,7 +339,7 @@ by the choice value: " (unless (eq major-mode 'dictionary-mode) - (incf dictionary-instances)) + (cl-incf dictionary-instances)) (kill-all-local-variables) (buffer-disable-undo) @@ -370,8 +358,6 @@ by the choice value: (make-local-variable 'dictionary-default-dictionary) (make-local-variable 'dictionary-default-strategy) - (if (featurep 'xemacs) - (make-local-hook 'kill-buffer-hook)) (add-hook 'kill-buffer-hook 'dictionary-close t t) (run-hooks 'dictionary-mode-hook)) @@ -519,7 +505,7 @@ by the choice value: (if (eq major-mode 'dictionary-mode) (progn (setq major-mode nil) - (if (<= (decf dictionary-instances) 0) + (if (<= (cl-decf dictionary-instances) 0) (dictionary-connection-close dictionary-connection)) (let ((configuration dictionary-window-configuration) (selected-window dictionary-selected-window)) @@ -1210,8 +1196,6 @@ It presents the word at point as default input and allows editing it." ;;; Tooltip support -;; Common to GNU Emacs and XEmacs - ;; Add a mode indicater named "Dict" (defvar dictionary-tooltip-mode nil @@ -1235,79 +1219,6 @@ It presents the word at point as default input and allows editing it." (let ((list (dictionary-simple-split-string (dictionary-read-answer) "\n+"))) (mapconcat 'identity (cdr list) "\n"))) -(defconst dictionary-use-balloon-help - (eval-when-compile - (condition-case nil - (require 'balloon-help) - (error nil)))) - -(make-variable-buffer-local 'dictionary-balloon-help-extent) - -(if dictionary-use-balloon-help - (progn - -;; The following definition are only valid for XEmacs with balloon-help - -(defvar dictionary-balloon-help-position nil - "Current position to lookup word") - -(defun dictionary-balloon-help-store-position (event) - (setq dictionary-balloon-help-position (event-point event))) - -(defun dictionary-balloon-help-description (&rest extent) - "Get the word from the cursor and lookup it" - (if dictionary-balloon-help-position - (let ((word (save-window-excursion - (save-excursion - (goto-char dictionary-balloon-help-position) - (current-word))))) - (let ((definition - (dictionary-definition word dictionary-tooltip-dictionary))) - (if definition - (dictionary-decode-charset definition - dictionary-tooltip-dictionary) - nil))))) - -(defvar dictionary-balloon-help-extent nil - "The extent for activating the balloon help") - -;;;###autoload -(defun dictionary-tooltip-mode (&optional arg) - "Display tooltips for the current word" - (interactive "P") - (let* ((on (if arg - (> (prefix-numeric-value arg) 0) - (not dictionary-tooltip-mode)))) - (make-local-variable 'dictionary-tooltip-mode) - (if on - ;; active mode - (progn - ;; remove old extend - (if dictionary-balloon-help-extent - (delete-extent dictionary-balloon-help-extent)) - ;; create new one - (setq dictionary-balloon-help-extent (make-extent (point-min) - (point-max))) - (set-extent-property dictionary-balloon-help-extent - 'balloon-help - 'dictionary-balloon-help-description) - (set-extent-property dictionary-balloon-help-extent - 'start-open nil) - (set-extent-property dictionary-balloon-help-extent - 'end-open nil) - (add-hook 'mouse-motion-hook - 'dictionary-balloon-help-store-position)) - - ;; deactivate mode - (if dictionary-balloon-help-extent - (delete-extent dictionary-balloon-help-extent)) - (remove-hook 'mouse-motion-hook - 'dictionary-balloon-help-store-position)) - (setq dictionary-tooltip-mode on) - (balloon-help-minor-mode on))) - -) ;; end of XEmacs part - (defvar global-dictionary-tooltip-mode nil) @@ -1317,16 +1228,16 @@ It presents the word at point as default input and allows editing it." (interactive "e") (if dictionary-tooltip-dictionary (let ((word (save-window-excursion - (save-excursion - (mouse-set-point event) - (current-word))))) - (let ((definition - (dictionary-definition word dictionary-tooltip-dictionary))) - (if definition - (tooltip-show - (dictionary-decode-charset definition - dictionary-tooltip-dictionary))) - t)) + (save-excursion + (mouse-set-point event) + (current-word))))) + (let ((definition + (dictionary-definition word dictionary-tooltip-dictionary))) + (if definition + (tooltip-show + (dictionary-decode-charset definition + dictionary-tooltip-dictionary))) + t)) nil)) ;;;###autoload @@ -1335,8 +1246,8 @@ It presents the word at point as default input and allows editing it." (interactive "P") (require 'tooltip) (let ((on (if arg - (> (prefix-numeric-value arg) 0) - (not dictionary-tooltip-mode)))) + (> (prefix-numeric-value arg) 0) + (not dictionary-tooltip-mode)))) (make-local-variable 'dictionary-tooltip-mode) (setq dictionary-tooltip-mode on) ;; make sure that tooltip is still (global available) even is on @@ -1352,16 +1263,13 @@ It presents the word at point as default input and allows editing it." (interactive "P") (require 'tooltip) (let* ((on (if arg (> (prefix-numeric-value arg) 0) - (not global-dictionary-tooltip-mode))) - (hook-fn (if on 'add-hook 'remove-hook))) + (not global-dictionary-tooltip-mode))) + (hook-fn (if on 'add-hook 'remove-hook))) (setq global-dictionary-tooltip-mode on) (tooltip-mode 1) (funcall hook-fn 'tooltip-hook 'dictionary-display-tooltip) (setq-default dictionary-tooltip-mode on) (setq-default track-mouse on))) -) ;; end of GNU Emacs part - (provide 'dictionary) - ;;; dictionary.el ends here commit e2ebffdd62c633d9b39994381adeccaacfe5d129 Author: Torsten Hilbrich Date: Mon Oct 5 07:11:25 2020 +0200 Renamed link.el * lisp/net/link.el: Renamed to connection-link.el, also prefixing all functions with "dictionary-" prefix * lisp/net/dictionary.el: Adapt to renamed functions diff --git a/lisp/net/link.el b/lisp/net/dictionary-link.el similarity index 72% rename from lisp/net/link.el rename to lisp/net/dictionary-link.el index 30eadb1017..86e853e64e 100644 --- a/lisp/net/link.el +++ b/lisp/net/dictionary-link.el @@ -1,4 +1,4 @@ -;;; link.el --- Hypertext links in text buffers +;;; dictionary-link.el --- Hypertext links in text buffers ;; Author: Torsten Hilbrich ;; Keywords: interface, hypermedia @@ -31,15 +31,12 @@ ;; argument. Both the function and the data are stored in text ;; properties. ;; -;; link-create-link - insert a new link for the text in the given range -;; link-initialize-keymap - install the keybinding for selecting links +;; dictionary-link-create-link - insert a new link for the text in the given range +;; dictionary-link-initialize-keymap - install the keybinding for selecting links ;;; Code: -(eval-when-compile - (require 'cl)) - -(defun link-create-link (start end face function &optional data help) +(defun dictionary-link-create-link (start end face function &optional data help) "Create a link in the current buffer starting from `start' going to `end'. The `face' is used for displaying, the `data' are stored together with the link. Upon clicking the `function' is called with `data' as argument." @@ -52,15 +49,15 @@ link. Upon clicking the `function' is called with `data' as argument." (remove-text-properties start end properties) (add-text-properties start end properties))) -(defun link-insert-link (text face function &optional data help) +(defun dictionary-link-insert-link (text face function &optional data help) "Insert the `text' at point to be formatted as link. The `face' is used for displaying, the `data' are stored together with the link. Upon clicking the `function' is called with `data' as argument." (let ((start (point))) (insert text) - (link-create-link start (point) face function data help))) + (dictionary-link-create-link start (point) face function data help))) -(defun link-selected (&optional all) +(defun dictionary-link-selected (&optional all) "Is called upon clicking or otherwise visiting the link." (interactive) @@ -70,26 +67,26 @@ link. Upon clicking the `function' is called with `data' as argument." (if function (funcall function data all)))) -(defun link-selected-all () +(defun dictionary-link-selected-all () "Called for meta clicking the link" (interactive) - (link-selected 'all)) + (dictionary-link-selected 'all)) -(defun link-mouse-click (event &optional all) +(defun dictionary-link-mouse-click (event &optional all) "Is called upon clicking the link." (interactive "@e") (mouse-set-point event) - (link-selected)) + (dictionary-link-selected)) -(defun link-mouse-click-all (event) +(defun dictionary-link-mouse-click-all (event) "Is called upon meta clicking the link." (interactive "@e") (mouse-set-point event) - (link-selected-all)) + (dictionary-link-selected-all)) -(defun link-next-link () +(defun dictionary-link-next-link () "Return the position of the next link or nil if there is none" (let* ((pos (point)) (pos (next-single-property-change pos 'link))) @@ -100,7 +97,7 @@ link. Upon clicking the `function' is called with `data' as argument." nil))) -(defun link-prev-link () +(defun dictionary-link-prev-link () "Return the position of the previous link or nil if there is none" (let* ((pos (point)) (pos (previous-single-property-change pos 'link))) @@ -113,17 +110,17 @@ link. Upon clicking the `function' is called with `data' as argument." (text-property-any (point-min) (1+ (point-min)) 'link t)))) nil))) -(defun link-initialize-keymap (keymap) +(defun dictionary-link-initialize-keymap (keymap) "Defines the necessary bindings inside keymap" (if (and (boundp 'running-xemacs) running-xemacs) (progn - (define-key keymap [button2] 'link-mouse-click) - (define-key keymap [(meta button2)] 'link-mouse-click-all)) - (define-key keymap [mouse-2] 'link-mouse-click) - (define-key keymap [M-mouse-2] 'link-mouse-click-all)) - (define-key keymap "\r" 'link-selected) - (define-key keymap "\M-\r" 'link-selected-all)) - -(provide 'link) -;;; link.el ends here + (define-key keymap [button2] 'dictionary-link-mouse-click) + (define-key keymap [(meta button2)] 'dictionary-link-mouse-click-all)) + (define-key keymap [mouse-2] 'dictionary-link-mouse-click) + (define-key keymap [M-mouse-2] 'dictionary-link-mouse-click-all)) + (define-key keymap "\r" 'dictionary-link-selected) + (define-key keymap "\M-\r" 'dictionary-link-selected-all)) + +(provide 'dictionary-link) +;;; dictionary-link.el ends here diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 7dd88e6e42..4b2f25c26b 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -40,7 +40,7 @@ (require 'easymenu) (require 'custom) (require 'dictionary-connection) -(require 'link) +(require 'dictionary-link) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Stuff for customizing. @@ -434,7 +434,7 @@ by the choice value: (define-key dictionary-mode-map " " 'scroll-up) (define-key dictionary-mode-map [(meta space)] 'scroll-down) - (link-initialize-keymap dictionary-mode-map)) + (dictionary-link-initialize-keymap dictionary-mode-map)) (defmacro dictionary-reply-code (reply) "Return the reply code stored in `reply'." @@ -713,37 +713,37 @@ This function knows about the special meaning of quotes (\")" (erase-buffer) (if dictionary-create-buttons (progn - (link-insert-link "[Back]" 'dictionary-button-face - 'dictionary-restore-state nil - "Mouse-2 to go backwards in history") + (dictionary-link-insert-link "[Back]" 'dictionary-button-face + 'dictionary-restore-state nil + "Mouse-2 to go backwards in history") (insert " ") - (link-insert-link "[Search Definition]" - 'dictionary-button-face - 'dictionary-search nil - "Mouse-2 to look up a new word") + (dictionary-link-insert-link "[Search Definition]" + 'dictionary-button-face + 'dictionary-search nil + "Mouse-2 to look up a new word") (insert " ") - (link-insert-link "[Matching words]" - 'dictionary-button-face - 'dictionary-match-words nil - "Mouse-2 to find matches for a pattern") + (dictionary-link-insert-link "[Matching words]" + 'dictionary-button-face + 'dictionary-match-words nil + "Mouse-2 to find matches for a pattern") (insert " ") - (link-insert-link "[Quit]" 'dictionary-button-face - 'dictionary-close nil - "Mouse-2 to close this window") + (dictionary-link-insert-link "[Quit]" 'dictionary-button-face + 'dictionary-close nil + "Mouse-2 to close this window") (insert "\n ") - (link-insert-link "[Select Dictionary]" - 'dictionary-button-face - 'dictionary-select-dictionary nil - "Mouse-2 to select dictionary for future searches") + (dictionary-link-insert-link "[Select Dictionary]" + 'dictionary-button-face + 'dictionary-select-dictionary nil + "Mouse-2 to select dictionary for future searches") (insert " ") - (link-insert-link "[Select Match Strategy]" - 'dictionary-button-face - 'dictionary-select-strategy nil - "Mouse-2 to select matching algorithm") + (dictionary-link-insert-link "[Select Match Strategy]" + 'dictionary-button-face + 'dictionary-select-strategy nil + "Mouse-2 to select matching algorithm") (insert "\n\n"))) (setq dictionary-marker (point-marker))) @@ -821,10 +821,10 @@ The word is taken from the buffer, the `dictionary' is given as argument." (setq word (replace-match "" t t word))) (unless (equal word displayed-word) - (link-create-link start end 'dictionary-reference-face - call (cons word dictionary) - (concat "Press Mouse-2 to lookup \"" - word "\" in \"" dictionary "\""))))) + (dictionary-link-create-link start end 'dictionary-reference-face + call (cons word dictionary) + (concat "Press Mouse-2 to lookup \"" + word "\" in \"" dictionary "\""))))) (defun dictionary-select-dictionary (&rest ignored) "Save the current state and start a dictionary selection" @@ -882,11 +882,11 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (if dictionary (if (equal dictionary "--exit--") (insert "(end of default search list)\n") - (link-insert-link (concat dictionary ": " translated) - 'dictionary-reference-face - 'dictionary-set-dictionary - (cons dictionary description) - "Mouse-2 to select this dictionary") + (dictionary-link-insert-link (concat dictionary ": " translated) + 'dictionary-reference-face + 'dictionary-set-dictionary + (cons dictionary description) + "Mouse-2 to select this dictionary") (insert "\n"))))) (defun dictionary-set-dictionary (param &optional more) @@ -918,10 +918,10 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (error "Unknown server answer: %s" (dictionary-reply reply))) (dictionary-pre-buffer) (insert "Information on dictionary: ") - (link-insert-link description 'dictionary-reference-face - 'dictionary-set-dictionary - (cons dictionary description) - "Mouse-2 to select this dictionary") + (dictionary-link-insert-link description 'dictionary-reference-face + 'dictionary-set-dictionary + (cons dictionary description) + "Mouse-2 to select this dictionary") (insert "\n\n") (setq reply (dictionary-read-answer)) (insert reply) @@ -969,9 +969,9 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (description (cadr list))) (if strategy (progn - (link-insert-link description 'dictionary-reference-face - 'dictionary-set-strategy strategy - "Mouse-2 to select this matching algorithm") + (dictionary-link-insert-link description 'dictionary-reference-face + 'dictionary-set-strategy strategy + "Mouse-2 to select this matching algorithm") (insert "\n"))))) (defun dictionary-set-strategy (strategy &rest ignored) @@ -1071,11 +1071,11 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (mapc (lambda (word) (setq word (dictionary-decode-charset word dictionary)) (insert " ") - (link-insert-link word - 'dictionary-reference-face - 'dictionary-new-search - (cons word dictionary) - "Mouse-2 to lookup word") + (dictionary-link-insert-link word + 'dictionary-reference-face + 'dictionary-new-search + (cons word dictionary) + "Mouse-2 to lookup word") (insert "\n")) (reverse word-list)) (insert "\n"))) list)) @@ -1133,7 +1133,7 @@ It presents the word at point as default input and allows editing it." (defun dictionary-next-link () "Place the cursor to the next link." (interactive) - (let ((pos (link-next-link))) + (let ((pos (dictionary-link-next-link))) (if pos (goto-char pos) (error "There is no next link")))) @@ -1141,7 +1141,7 @@ It presents the word at point as default input and allows editing it." (defun dictionary-prev-link () "Place the cursor to the previous link." (interactive) - (let ((pos (link-prev-link))) + (let ((pos (dictionary-link-prev-link))) (if pos (goto-char pos) (error "There is no previous link")))) commit 658ec3ccee50cd36ee2de267c4d91f7f6e2845a2 Author: Torsten Hilbrich Date: Mon Oct 5 06:56:59 2020 +0200 Renamed connection.el * lisp/net/connection.el: Renamed to dictionary-connection.el, also prefixing all functions with "dictionary-" prefix * lisp/net/dictionary.el: Adapt to renamed functions diff --git a/lisp/net/connection.el b/lisp/net/connection.el deleted file mode 100644 index 3afcc2cb89..0000000000 --- a/lisp/net/connection.el +++ /dev/null @@ -1,159 +0,0 @@ -;;; connection.el --- TCP-based client connection - -;; Author: Torsten Hilbrich -;; Keywords: network -;; Version: 1.11 - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; connection allows to handle TCP-based connections in client mode -;; where text-based information are exchanged. There is special -;; support for handling CR LF (and the usual CR LF . CR LF -;; terminater). - -;;; Code: - -(eval-when-compile - (require 'cl)) - -(defmacro connection-p (connection) - "Returns non-nil if `connection' is a connection object" - (list 'get connection ''connection)) - -(defmacro connection-read-point (connection) - "Return the read point of the connection object." - (list 'get connection ''connection-read-point)) - -(defmacro connection-process (connection) - "Return the process of the connection object." - (list 'get connection ''connection-process)) - -(defmacro connection-buffer (connection) - "Return the buffer of the connection object." - (list 'get connection ''connection-buffer)) - -(defmacro connection-set-read-point (connection point) - "Set the read-point for `connection' to `point'." - (list 'put connection ''connection-read-point point)) - -(defmacro connection-set-process (connection process) - "Set the process for `connection' to `process'." - (list 'put connection ''connection-process process)) - -(defmacro connection-set-buffer (connection buffer) - "Set the buffer for `connection' to `buffer'." - (list 'put connection ''connection-buffer buffer)) - -(defun connection-create-data (buffer process point) - "Create a new connection data based on `buffer', `process', and `point'." - (let ((connection (make-symbol "connection"))) - (put connection 'connection t) - (connection-set-read-point connection point) - (connection-set-process connection process) - (connection-set-buffer connection buffer) - connection)) - -(defun connection-open (server port) - "Open a connection to `server' and `port'. -A data structure identifing the connection is returned" - - (let ((process-buffer (generate-new-buffer (format " connection to %s:%s" - server - port))) - (process)) - (with-current-buffer process-buffer - (setq process (open-network-stream "connection" process-buffer - server port)) - (connection-create-data process-buffer process (point-min))))) - -(defun connection-status (connection) - "Return the status of the connection. -Possible return values are the symbols: -nil: argument is no connection object -'none: argument has no connection -'up: connection is open and buffer is existing -'down: connection is closed -'alone: connection is not associated with a buffer" - (if (connection-p connection) - (let ((process (connection-process connection)) - (buffer (connection-buffer connection))) - (if (not process) - 'none - (if (not (buffer-live-p buffer)) - 'alone - (if (not (eq (process-status process) 'open)) - 'down - 'up)))) - nil)) - -(defun connection-close (connection) - "Force closing of the connection." - (if (connection-p connection) - (progn - (let ((buffer (connection-buffer connection)) - (process (connection-process connection))) - (if process - (delete-process process)) - (if buffer - (kill-buffer buffer)) - - (connection-set-process connection nil) - (connection-set-buffer connection nil))))) - -(defun connection-send (connection data) - "Send `data' to the process." - (unless (eq (connection-status connection) 'up) - (error "Connection is not up")) - (with-current-buffer (connection-buffer connection) - (goto-char (point-max)) - (connection-set-read-point connection (point)) - (process-send-string (connection-process connection) data))) - -(defun connection-send-crlf (connection data) - "Send `data' together with CRLF to the process." - (connection-send connection (concat data "\r\n"))) - -(defun connection-read (connection delimiter) - "Read data until `delimiter' is found inside the buffer." - (unless (eq (connection-status connection) 'up) - (error "Connection is not up")) - (let ((case-fold-search nil) - match-end) - (with-current-buffer (connection-buffer connection) - (goto-char (connection-read-point connection)) - ;; Wait until there is enough data - (while (not (search-forward-regexp delimiter nil t)) - (accept-process-output (connection-process connection) 3) - (goto-char (connection-read-point connection))) - (setq match-end (point)) - ;; Return the result - (let ((result (buffer-substring (connection-read-point connection) - match-end))) - (connection-set-read-point connection match-end) - result)))) - -(defun connection-read-crlf (connection) - "Read until a line is completedx with CRLF" - (connection-read connection "\015?\012")) - -(defun connection-read-to-point (connection) - "Read until a line is consisting of a single point" - (connection-read connection "\015?\012[.]\015?\012")) - -(provide 'connection) -;;; connection.el ends here diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el new file mode 100644 index 0000000000..f1d11bf3c5 --- /dev/null +++ b/lisp/net/dictionary-connection.el @@ -0,0 +1,156 @@ +;;; dictionary-connection.el --- TCP-based client connection for dictionary + +;; Author: Torsten Hilbrich +;; Keywords: network +;; Version: 1.11 + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; dictionary-connection allows to handle TCP-based connections in +;; client mode where text-based information are exchanged. There is +;; special support for handling CR LF (and the usual CR LF . CR LF +;; terminater). + +;;; Code: + +(defmacro dictionary-connection-p (connection) + "Returns non-nil if `connection' is a connection object" + (list 'get connection ''connection)) + +(defmacro dictionary-connection-read-point (connection) + "Return the read point of the connection object." + (list 'get connection ''dictionary-connection-read-point)) + +(defmacro dictionary-connection-process (connection) + "Return the process of the connection object." + (list 'get connection ''dictionary-connection-process)) + +(defmacro dictionary-connection-buffer (connection) + "Return the buffer of the connection object." + (list 'get connection ''dictionary-connection-buffer)) + +(defmacro dictionary-connection-set-read-point (connection point) + "Set the read-point for `connection' to `point'." + (list 'put connection ''dictionary-connection-read-point point)) + +(defmacro dictionary-connection-set-process (connection process) + "Set the process for `connection' to `process'." + (list 'put connection ''dictionary-connection-process process)) + +(defmacro dictionary-connection-set-buffer (connection buffer) + "Set the buffer for `connection' to `buffer'." + (list 'put connection ''dictionary-connection-buffer buffer)) + +(defun dictionary-connection-create-data (buffer process point) + "Create a new connection data based on `buffer', `process', and `point'." + (let ((connection (make-symbol "connection"))) + (put connection 'connection t) + (dictionary-connection-set-read-point connection point) + (dictionary-connection-set-process connection process) + (dictionary-connection-set-buffer connection buffer) + connection)) + +(defun dictionary-connection-open (server port) + "Open a connection to `server' and `port'. +A data structure identifing the connection is returned" + + (let ((process-buffer (generate-new-buffer (format " connection to %s:%s" + server + port))) + (process)) + (with-current-buffer process-buffer + (setq process (open-network-stream "connection" process-buffer + server port)) + (dictionary-connection-create-data process-buffer process (point-min))))) + +(defun dictionary-connection-status (connection) + "Return the status of the connection. +Possible return values are the symbols: +nil: argument is no connection object +'none: argument has no connection +'up: connection is open and buffer is existing +'down: connection is closed +'alone: connection is not associated with a buffer" + (if (dictionary-connection-p connection) + (let ((process (dictionary-connection-process connection)) + (buffer (dictionary-connection-buffer connection))) + (if (not process) + 'none + (if (not (buffer-live-p buffer)) + 'alone + (if (not (eq (process-status process) 'open)) + 'down + 'up)))) + nil)) + +(defun dictionary-connection-close (connection) + "Force closing of the connection." + (if (dictionary-connection-p connection) + (progn + (let ((buffer (dictionary-connection-buffer connection)) + (process (dictionary-connection-process connection))) + (if process + (delete-process process)) + (if buffer + (kill-buffer buffer)) + + (dictionary-connection-set-process connection nil) + (dictionary-connection-set-buffer connection nil))))) + +(defun dictionary-connection-send (connection data) + "Send `data' to the process." + (unless (eq (dictionary-connection-status connection) 'up) + (error "Connection is not up")) + (with-current-buffer (dictionary-connection-buffer connection) + (goto-char (point-max)) + (dictionary-connection-set-read-point connection (point)) + (process-send-string (dictionary-connection-process connection) data))) + +(defun dictionary-connection-send-crlf (connection data) + "Send `data' together with CRLF to the process." + (dictionary-connection-send connection (concat data "\r\n"))) + +(defun dictionary-connection-read (connection delimiter) + "Read data until `delimiter' is found inside the buffer." + (unless (eq (dictionary-connection-status connection) 'up) + (error "Connection is not up")) + (let ((case-fold-search nil) + match-end) + (with-current-buffer (dictionary-connection-buffer connection) + (goto-char (dictionary-connection-read-point connection)) + ;; Wait until there is enough data + (while (not (search-forward-regexp delimiter nil t)) + (accept-process-output (dictionary-connection-process connection) 3) + (goto-char (dictionary-connection-read-point connection))) + (setq match-end (point)) + ;; Return the result + (let ((result (buffer-substring (dictionary-connection-read-point connection) + match-end))) + (dictionary-connection-set-read-point connection match-end) + result)))) + +(defun dictionary-connection-read-crlf (connection) + "Read until a line is completedx with CRLF" + (dictionary-connection-read connection "\015?\012")) + +(defun dictionary-connection-read-to-point (connection) + "Read until a line is consisting of a single point" + (dictionary-connection-read connection "\015?\012[.]\015?\012")) + +(provide 'dictionary-connection) +;;; dictionary-connection.el ends here diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 9545926cb2..7dd88e6e42 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -39,7 +39,7 @@ (require 'easymenu) (require 'custom) -(require 'connection) +(require 'dictionary-connection) (require 'link) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -60,10 +60,10 @@ (defun dictionary-set-server-var (name value) (if (and (boundp 'dictionary-connection) dictionary-connection - (eq (connection-status dictionary-connection) 'up) + (eq (dictionary-connection-status dictionary-connection) 'up) (y-or-n-p (concat "Close existing connection to " dictionary-server "? "))) - (connection-close dictionary-connection)) + (dictionary-connection-close dictionary-connection)) (set-default name value)) (defgroup dictionary nil @@ -451,7 +451,7 @@ by the choice value: (defun dictionary-check-connection () "Check if there is already a connection open" (if (not (and dictionary-connection - (eq (connection-status dictionary-connection) 'up))) + (eq (dictionary-connection-status dictionary-connection) 'up))) (let ((wanted 'raw-text) (coding-system nil)) (if (and (fboundp 'coding-system-list) @@ -461,14 +461,14 @@ by the choice value: (coding-system-for-write coding-system)) (message "Opening connection to %s:%s" dictionary-server dictionary-port) - (connection-close dictionary-connection) + (dictionary-connection-close dictionary-connection) (setq dictionary-connection (if dictionary-use-http-proxy - (connection-open dictionary-proxy-server - dictionary-proxy-port) - (connection-open dictionary-server dictionary-port))) + (dictionary-connection-open dictionary-proxy-server + dictionary-proxy-port) + (dictionary-connection-open dictionary-server dictionary-port))) (set-process-query-on-exit-flag - (connection-process dictionary-connection) + (dictionary-connection-process dictionary-connection) nil) (when dictionary-use-http-proxy @@ -520,7 +520,7 @@ by the choice value: (progn (setq major-mode nil) (if (<= (decf dictionary-instances) 0) - (connection-close dictionary-connection)) + (dictionary-connection-close dictionary-connection)) (let ((configuration dictionary-window-configuration) (selected-window dictionary-selected-window)) (kill-buffer (current-buffer)) @@ -535,11 +535,11 @@ by the choice value: "Send the command `string' to the network connection." (dictionary-check-connection) ;;;; ##### - (connection-send-crlf dictionary-connection string)) + (dictionary-connection-send-crlf dictionary-connection string)) (defun dictionary-read-reply () "Read the reply line from the server" - (let ((answer (connection-read-crlf dictionary-connection))) + (let ((answer (dictionary-connection-read-crlf dictionary-connection))) (if (string-match "\r?\n" answer) (substring answer 0 (match-beginning 0)) answer))) @@ -574,7 +574,7 @@ This function knows about the special meaning of quotes (\")" (defun dictionary-read-answer () "Read an answer delimited by a . on a single line" - (let ((answer (connection-read-to-point dictionary-connection)) + (let ((answer (dictionary-connection-read-to-point dictionary-connection)) (start 0)) (while (string-match "\r\n" answer start) (setq answer (replace-match "\n" t t answer)) @@ -623,7 +623,7 @@ This function knows about the special meaning of quotes (\")" "Read the first reply from server and check it." (let ((reply (dictionary-read-reply-and-split))) (unless (dictionary-check-reply reply 220) - (connection-close dictionary-connection) + (dictionary-connection-close dictionary-connection) (error "Server returned: %s" (dictionary-reply reply))))) ;; Store the current state commit b6227446d9166130cf6d30b0fc11428fe001c90c Author: Torsten Hilbrich Date: Mon Oct 5 06:50:25 2020 +0200 Importing dictionary module * lisp/net: Adding files connection.el, link.el, dictionary.el, imported from https://github.com/myrkr/dictionary-el.git diff --git a/lisp/net/connection.el b/lisp/net/connection.el new file mode 100644 index 0000000000..3afcc2cb89 --- /dev/null +++ b/lisp/net/connection.el @@ -0,0 +1,159 @@ +;;; connection.el --- TCP-based client connection + +;; Author: Torsten Hilbrich +;; Keywords: network +;; Version: 1.11 + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; connection allows to handle TCP-based connections in client mode +;; where text-based information are exchanged. There is special +;; support for handling CR LF (and the usual CR LF . CR LF +;; terminater). + +;;; Code: + +(eval-when-compile + (require 'cl)) + +(defmacro connection-p (connection) + "Returns non-nil if `connection' is a connection object" + (list 'get connection ''connection)) + +(defmacro connection-read-point (connection) + "Return the read point of the connection object." + (list 'get connection ''connection-read-point)) + +(defmacro connection-process (connection) + "Return the process of the connection object." + (list 'get connection ''connection-process)) + +(defmacro connection-buffer (connection) + "Return the buffer of the connection object." + (list 'get connection ''connection-buffer)) + +(defmacro connection-set-read-point (connection point) + "Set the read-point for `connection' to `point'." + (list 'put connection ''connection-read-point point)) + +(defmacro connection-set-process (connection process) + "Set the process for `connection' to `process'." + (list 'put connection ''connection-process process)) + +(defmacro connection-set-buffer (connection buffer) + "Set the buffer for `connection' to `buffer'." + (list 'put connection ''connection-buffer buffer)) + +(defun connection-create-data (buffer process point) + "Create a new connection data based on `buffer', `process', and `point'." + (let ((connection (make-symbol "connection"))) + (put connection 'connection t) + (connection-set-read-point connection point) + (connection-set-process connection process) + (connection-set-buffer connection buffer) + connection)) + +(defun connection-open (server port) + "Open a connection to `server' and `port'. +A data structure identifing the connection is returned" + + (let ((process-buffer (generate-new-buffer (format " connection to %s:%s" + server + port))) + (process)) + (with-current-buffer process-buffer + (setq process (open-network-stream "connection" process-buffer + server port)) + (connection-create-data process-buffer process (point-min))))) + +(defun connection-status (connection) + "Return the status of the connection. +Possible return values are the symbols: +nil: argument is no connection object +'none: argument has no connection +'up: connection is open and buffer is existing +'down: connection is closed +'alone: connection is not associated with a buffer" + (if (connection-p connection) + (let ((process (connection-process connection)) + (buffer (connection-buffer connection))) + (if (not process) + 'none + (if (not (buffer-live-p buffer)) + 'alone + (if (not (eq (process-status process) 'open)) + 'down + 'up)))) + nil)) + +(defun connection-close (connection) + "Force closing of the connection." + (if (connection-p connection) + (progn + (let ((buffer (connection-buffer connection)) + (process (connection-process connection))) + (if process + (delete-process process)) + (if buffer + (kill-buffer buffer)) + + (connection-set-process connection nil) + (connection-set-buffer connection nil))))) + +(defun connection-send (connection data) + "Send `data' to the process." + (unless (eq (connection-status connection) 'up) + (error "Connection is not up")) + (with-current-buffer (connection-buffer connection) + (goto-char (point-max)) + (connection-set-read-point connection (point)) + (process-send-string (connection-process connection) data))) + +(defun connection-send-crlf (connection data) + "Send `data' together with CRLF to the process." + (connection-send connection (concat data "\r\n"))) + +(defun connection-read (connection delimiter) + "Read data until `delimiter' is found inside the buffer." + (unless (eq (connection-status connection) 'up) + (error "Connection is not up")) + (let ((case-fold-search nil) + match-end) + (with-current-buffer (connection-buffer connection) + (goto-char (connection-read-point connection)) + ;; Wait until there is enough data + (while (not (search-forward-regexp delimiter nil t)) + (accept-process-output (connection-process connection) 3) + (goto-char (connection-read-point connection))) + (setq match-end (point)) + ;; Return the result + (let ((result (buffer-substring (connection-read-point connection) + match-end))) + (connection-set-read-point connection match-end) + result)))) + +(defun connection-read-crlf (connection) + "Read until a line is completedx with CRLF" + (connection-read connection "\015?\012")) + +(defun connection-read-to-point (connection) + "Read until a line is consisting of a single point" + (connection-read connection "\015?\012[.]\015?\012")) + +(provide 'connection) +;;; connection.el ends here diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el new file mode 100644 index 0000000000..9545926cb2 --- /dev/null +++ b/lisp/net/dictionary.el @@ -0,0 +1,1367 @@ +;;; dictionary.el --- Client for rfc2229 dictionary servers + +;; Author: Torsten Hilbrich +;; Keywords: interface, dictionary +;; Version: 1.11 +;; Package-Requires: ((connection "1.11") (link "1.11")) + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; dictionary allows you to interact with dictionary servers. +;; Use M-x customize-group dictionary to modify user settings. +;; +;; Main functions for interaction are: +;; dictionary - opens a new dictionary buffer +;; dictionary-search - search for the definition of a word +;; +;; You can find more information in the README file of the GitHub +;; repository https://github.com/myrkr/dictionary-el + +;;; Code: + +(eval-when-compile + (require 'cl)) + +(require 'easymenu) +(require 'custom) +(require 'connection) +(require 'link) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Stuff for customizing. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(eval-when-compile + (unless (fboundp 'defface) + (message "Please update your custom.el file: %s" + "http://www.dina.kvl.dk/~abraham/custom/")) + + (unless (fboundp 'defgroup) + (defmacro defgroup (&rest ignored)) + (defmacro defcustom (var value doc &rest ignored) + (list 'defvar var value doc)))) + +(defvar dictionary-server) +(defun dictionary-set-server-var (name value) + (if (and (boundp 'dictionary-connection) + dictionary-connection + (eq (connection-status dictionary-connection) 'up) + (y-or-n-p + (concat "Close existing connection to " dictionary-server "? "))) + (connection-close dictionary-connection)) + (set-default name value)) + +(defgroup dictionary nil + "Client for accessing the dictd server based dictionaries" + :group 'hypermedia) + +(defgroup dictionary-proxy nil + "Proxy configuration options for the dictionary client" + :group 'dictionary) + +(defcustom dictionary-server + "dict.org" + "This server is contacted for searching the dictionary" + :group 'dictionary + :set 'dictionary-set-server-var + :type 'string) + +(defcustom dictionary-port + 2628 + "The port of the dictionary server. + This port is propably always 2628 so there should be no need to modify it." + :group 'dictionary + :set 'dictionary-set-server-var + :type 'number) + +(defcustom dictionary-identification + "dictionary.el emacs lisp dictionary client" + "This is the identification string that will be sent to the server." + :group 'dictionary + :type 'string) + +(defcustom dictionary-default-dictionary + "*" + "The dictionary which is used for searching definitions and matching. + * and ! have a special meaning, * search all dictionaries, ! search until + one dictionary yields matches." + :group 'dictionary + :type 'string) + +(defcustom dictionary-default-strategy + "." + "The default strategy for listing matching words." + :group 'dictionary + :type 'string) + +(defcustom dictionary-default-popup-strategy + "exact" + "The default strategy for listing matching words within a popup window. + +The following algorithm (defined by the dictd server) are supported +by the choice value: + +- Exact match + + The found word exactly matches the searched word. + +- Similiar sounding + + The found word sounds similiar to the searched word. For this match type + the soundex algorithm defined by Donald E. Knuth is used. It will only + works with english words and the algorithm is not very reliable (i.e., + the soundex algorithm is quite simple). + +- Levenshtein distance one + + The Levenshtein distance is defined as the number of insertions, deletions, + or replacements needed to get the searched word. This algorithm searches + for word where spelling mistakes are allowed. Levenshtein distance one + means there is either a deleted character, an inserted character, or a + modified one. + +- User choice + + Here you can enter any matching algorithm supported by your + dictionary server. +" + :group 'dictionary + :type '(choice (const :tag "Exact match" "exact") + (const :tag "Similiar sounding" "soundex") + (const :tag "Levenshtein distance one" "lev") + (string :tag "User choice"))) + +(defcustom dictionary-create-buttons + t + "Create some clickable buttons on top of the window if non-nil." + :group 'dictionary + :type 'boolean) + +(defcustom dictionary-mode-hook + nil + "Hook run in dictionary mode buffers." + :group 'dictionary + :type 'hook) + +(defcustom dictionary-use-http-proxy + nil + "Connects via a HTTP proxy using the CONNECT command when not nil." + :group 'dictionary-proxy + :set 'dictionary-set-server-var + :type 'boolean) + +(defcustom dictionary-proxy-server + "proxy" + "The name of the HTTP proxy to use when dictionary-use-http-proxy is set." + :group 'dictionary-proxy + :set 'dictionary-set-server-var + :type 'string) + +(defcustom dictionary-proxy-port + 3128 + "The port of the proxy server, used only when dictionary-use-http-proxy is set." + :group 'dictionary-proxy + :set 'dictionary-set-server-var + :type 'number) + +(defcustom dictionary-use-single-buffer + nil + "Should the dictionary command reuse previous dictionary buffers?" + :group 'dictionary + :type 'boolean) + +(defcustom dictionary-description-open-delimiter + "" + "The delimiter to display in front of the dictionaries description" + :group 'dictionary + :type 'string) + +(defcustom dictionary-description-close-delimiter + "" + "The delimiter to display after of the dictionaries description" + :group 'dictionary + :type 'string) + +;; Define only when coding-system-list is available +(when (fboundp 'coding-system-list) + (defcustom dictionary-coding-systems-for-dictionaries + '( ("mueller" . koi8-r)) + "Mapping of dictionaries to coding systems. + Each entry in this list defines the coding system to be used for that + dictionary. The default coding system for all other dictionaries + is utf-8" + :group 'dictionary + :type `(repeat (cons :tag "Association" + (string :tag "Dictionary name") + (choice :tag "Coding system" + :value 'utf-8 + ,@(mapcar (lambda (x) (list 'const x)) + (coding-system-list)) + )))) + + ) + +(if (fboundp 'defface) + (progn + + (defface dictionary-word-definition-face + '((((supports (:family "DejaVu Serif"))) + (:family "DejaVu Serif")) + (((type x)) + (:font "Sans Serif")) + (t + (:font "default"))) + "The face that is used for displaying the definition of the word." + :group 'dictionary) + + (defface dictionary-word-entry-face + '((((type x)) + (:italic t)) + (((type tty) (class color)) + (:foreground "green")) + (t + (:inverse t))) + "The face that is used for displaying the initial word entry line." + :group 'dictionary) + + (defface dictionary-button-face + '((t + (:bold t))) + "The face that is used for displaying buttons." + :group 'dictionary) + + (defface dictionary-reference-face + '((((type x) + (class color) + (background dark)) + (:foreground "yellow")) + (((type tty) + (class color) + (background dark)) + (:foreground "cyan")) + (((class color) + (background light)) + (:foreground "blue")) + (t + (:underline t))) + + "The face that is used for displaying a reference word." + :group 'dictionary) + + ) + + ;; else + (copy-face 'italic 'dictionary-word-entry-face) + (copy-face 'bold 'dictionary-button-face) + (copy-face 'default 'dictionary-reference-face) + (set-face-foreground 'dictionary-reference-face "blue")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Buffer local variables for storing the current state +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar dictionary-window-configuration + nil + "The window configuration to be restored upon closing the buffer") + +(defvar dictionary-selected-window + nil + "The currently selected window") + +(defvar dictionary-position-stack + nil + "The history buffer for point and window position") + +(defvar dictionary-data-stack + nil + "The history buffer for functions and arguments") + +(defvar dictionary-positions + nil + "The current positions") + +(defvar dictionary-current-data + nil + "The item that will be placed on stack next time") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Global variables +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defvar dictionary-mode-map + nil + "Keymap for dictionary mode") + +(defvar dictionary-connection + nil + "The current network connection") + +(defvar dictionary-instances + 0 + "The number of open dictionary buffers") + +(defvar dictionary-marker + nil + "Stores the point position while buffer display.") + +(defvar dictionary-color-support + (condition-case nil + (x-display-color-p) + (error nil)) + "Determines if the Emacs has support to display color") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Basic function providing startup actions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;###autoload +(defun dictionary-mode () + "This is a mode for searching a dictionary server implementing + the protocol defined in RFC 2229. + + This is a quick reference to this mode describing the default key bindings: + + * q close the dictionary buffer + * h display this help information + * s ask for a new word to search + * d search the word at point + * n or Tab place point to the next link + * p or S-Tab place point to the prev link + + * m ask for a pattern and list all matching words. + * D select the default dictionary + * M select the default search strategy + + * Return or Button2 visit that link + * M-Return or M-Button2 search the word beneath link in all dictionaries + " + + (unless (eq major-mode 'dictionary-mode) + (incf dictionary-instances)) + + (kill-all-local-variables) + (buffer-disable-undo) + (use-local-map dictionary-mode-map) + (setq major-mode 'dictionary-mode) + (setq mode-name "Dictionary") + + (make-local-variable 'dictionary-data-stack) + (setq dictionary-data-stack nil) + (make-local-variable 'dictionary-position-stack) + (setq dictionary-position-stack nil) + + (make-local-variable 'dictionary-current-data) + (make-local-variable 'dictionary-positions) + + (make-local-variable 'dictionary-default-dictionary) + (make-local-variable 'dictionary-default-strategy) + + (if (featurep 'xemacs) + (make-local-hook 'kill-buffer-hook)) + (add-hook 'kill-buffer-hook 'dictionary-close t t) + (run-hooks 'dictionary-mode-hook)) + +;;;###autoload +(defun dictionary () + "Create a new dictonary buffer and install dictionary-mode" + (interactive) + (let ((buffer (or (and dictionary-use-single-buffer + (get-buffer "*Dictionary*")) + (generate-new-buffer "*Dictionary*"))) + (window-configuration (current-window-configuration)) + (selected-window (frame-selected-window))) + + (switch-to-buffer-other-window buffer) + (dictionary-mode) + + (make-local-variable 'dictionary-window-configuration) + (make-local-variable 'dictionary-selected-window) + (setq dictionary-window-configuration window-configuration) + (setq dictionary-selected-window selected-window) + (dictionary-check-connection) + (dictionary-new-buffer) + (dictionary-store-positions) + (dictionary-store-state 'dictionary-new-buffer nil))) + +(defun dictionary-new-buffer (&rest ignore) + "Create a new and clean buffer" + + (dictionary-pre-buffer) + (dictionary-post-buffer)) + + +(unless dictionary-mode-map + (setq dictionary-mode-map (make-sparse-keymap)) + (suppress-keymap dictionary-mode-map) + + (define-key dictionary-mode-map "q" 'dictionary-close) + (define-key dictionary-mode-map "h" 'dictionary-help) + (define-key dictionary-mode-map "s" 'dictionary-search) + (define-key dictionary-mode-map "d" 'dictionary-lookup-definition) + (define-key dictionary-mode-map "D" 'dictionary-select-dictionary) + (define-key dictionary-mode-map "M" 'dictionary-select-strategy) + (define-key dictionary-mode-map "m" 'dictionary-match-words) + (define-key dictionary-mode-map "l" 'dictionary-previous) + + (if (and (string-match "GNU" (emacs-version)) + (not window-system)) + (define-key dictionary-mode-map [9] 'dictionary-next-link) + (define-key dictionary-mode-map [tab] 'dictionary-next-link)) + + ;; shift-tabs normally is supported on window systems only, but + ;; I do not enforce it + (define-key dictionary-mode-map [(shift tab)] 'dictionary-prev-link) + (define-key dictionary-mode-map "\e\t" 'dictionary-prev-link) + (define-key dictionary-mode-map [backtab] 'dictionary-prev-link) + + (define-key dictionary-mode-map "n" 'dictionary-next-link) + (define-key dictionary-mode-map "p" 'dictionary-prev-link) + + (define-key dictionary-mode-map " " 'scroll-up) + (define-key dictionary-mode-map [(meta space)] 'scroll-down) + + (link-initialize-keymap dictionary-mode-map)) + +(defmacro dictionary-reply-code (reply) + "Return the reply code stored in `reply'." + (list 'get reply ''reply-code)) + +(defmacro dictionary-reply (reply) + "Return the string reply stored in `reply'." + (list 'get reply ''reply)) + +(defmacro dictionary-reply-list (reply) + "Return the reply list stored in `reply'." + (list 'get reply ''reply-list)) + +(defun dictionary-check-connection () + "Check if there is already a connection open" + (if (not (and dictionary-connection + (eq (connection-status dictionary-connection) 'up))) + (let ((wanted 'raw-text) + (coding-system nil)) + (if (and (fboundp 'coding-system-list) + (member wanted (coding-system-list))) + (setq coding-system wanted)) + (let ((coding-system-for-read coding-system) + (coding-system-for-write coding-system)) + (message "Opening connection to %s:%s" dictionary-server + dictionary-port) + (connection-close dictionary-connection) + (setq dictionary-connection + (if dictionary-use-http-proxy + (connection-open dictionary-proxy-server + dictionary-proxy-port) + (connection-open dictionary-server dictionary-port))) + (set-process-query-on-exit-flag + (connection-process dictionary-connection) + nil) + + (when dictionary-use-http-proxy + (message "Proxy CONNECT to %s:%d" + dictionary-proxy-server + dictionary-proxy-port) + (dictionary-send-command (format "CONNECT %s:%d HTTP/1.1" + dictionary-server + dictionary-port)) + ;; just a \r\n combination + (dictionary-send-command "") + + ;; read first line of reply + (let* ((reply (dictionary-read-reply)) + (reply-list (dictionary-split-string reply))) + ;; first item is protocol, second item is code + (unless (= (string-to-number (cadr reply-list)) 200) + (error "Bad reply from proxy server %s" reply)) + + ;; skip the following header lines until empty found + (while (not (equal reply "")) + (setq reply (dictionary-read-reply))))) + + (dictionary-check-initial-reply) + (dictionary-send-command (concat "client " dictionary-identification)) + (let ((reply (dictionary-read-reply-and-split))) + (message nil) + (unless (dictionary-check-reply reply 250) + (error "Unknown server answer: %s" + (dictionary-reply reply)))))))) + +(defun dictionary-mode-p () + "Return non-nil if current buffer has dictionary-mode" + (eq major-mode 'dictionary-mode)) + +(defun dictionary-ensure-buffer () + "If current buffer is not a dictionary buffer, create a new one." + (unless (dictionary-mode-p) + (dictionary))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dealing with closing the buffer +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun dictionary-close (&rest ignore) + "Close the current dictionary buffer and its connection" + (interactive) + (if (eq major-mode 'dictionary-mode) + (progn + (setq major-mode nil) + (if (<= (decf dictionary-instances) 0) + (connection-close dictionary-connection)) + (let ((configuration dictionary-window-configuration) + (selected-window dictionary-selected-window)) + (kill-buffer (current-buffer)) + (set-window-configuration configuration) + (select-window selected-window))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Helpful functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun dictionary-send-command (string) + "Send the command `string' to the network connection." + (dictionary-check-connection) + ;;;; ##### + (connection-send-crlf dictionary-connection string)) + +(defun dictionary-read-reply () + "Read the reply line from the server" + (let ((answer (connection-read-crlf dictionary-connection))) + (if (string-match "\r?\n" answer) + (substring answer 0 (match-beginning 0)) + answer))) + +(defun dictionary-split-string (string) + "Split the `string' constiting of space separated words into elements. +This function knows about the special meaning of quotes (\")" + (let ((list)) + (while (and string (> (length string) 0)) + (let ((search "\\(\\s-+\\)") + (start 0)) + (if (= (aref string 0) ?\") + (setq search "\\(\"\\)\\s-*" + start 1)) + (if (string-match search string start) + (progn + (setq list (cons (substring string start (- (match-end 1) 1)) list) + string (substring string (match-end 0)))) + (setq list (cons string list) + string nil)))) + (nreverse list))) + +(defun dictionary-read-reply-and-split () + "Read the reply, split it into words and return it" + (let ((answer (make-symbol "reply-data")) + (reply (dictionary-read-reply))) + (let ((reply-list (dictionary-split-string reply))) + (put answer 'reply reply) + (put answer 'reply-list reply-list) + (put answer 'reply-code (string-to-number (car reply-list))) + answer))) + +(defun dictionary-read-answer () + "Read an answer delimited by a . on a single line" + (let ((answer (connection-read-to-point dictionary-connection)) + (start 0)) + (while (string-match "\r\n" answer start) + (setq answer (replace-match "\n" t t answer)) + (setq start (1- (match-end 0)))) + (setq start 0) + (if (string-match "\n\\.\n.*" answer start) + (setq answer (replace-match "" t t answer))) + answer)) + +(defun dictionary-check-reply (reply code) + "Check if the reply in `reply' has the `code'." + (let ((number (dictionary-reply-code reply))) + (and (numberp number) + (= number code)))) + +(defun dictionary-coding-system (dictionary) + "Select coding system to use for that dictionary" + (when (boundp 'dictionary-coding-systems-for-dictionaries) + (let ((coding-system + (or (cdr (assoc dictionary + dictionary-coding-systems-for-dictionaries)) + 'utf-8))) + (if (member coding-system (coding-system-list)) + coding-system + nil)))) + +(defun dictionary-decode-charset (text dictionary) + "Convert the text from the charset defined by the dictionary given." + (let ((coding-system (dictionary-coding-system dictionary))) + (if coding-system + (decode-coding-string text coding-system) + text))) + +(defun dictionary-encode-charset (text dictionary) + "Convert the text to the charset defined by the dictionary given." + (let ((coding-system (dictionary-coding-system dictionary))) + (if coding-system + (encode-coding-string text coding-system) + text))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Communication functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun dictionary-check-initial-reply () + "Read the first reply from server and check it." + (let ((reply (dictionary-read-reply-and-split))) + (unless (dictionary-check-reply reply 220) + (connection-close dictionary-connection) + (error "Server returned: %s" (dictionary-reply reply))))) + +;; Store the current state +(defun dictionary-store-state (function data) + "Stores the current state of operation for later restore." + + (if dictionary-current-data + (progn + (push dictionary-current-data dictionary-data-stack) + (unless dictionary-positions + (error "dictionary-store-state called before dictionary-store-positions")) + (push dictionary-positions dictionary-position-stack))) + (setq dictionary-current-data + (cons function data))) + +(defun dictionary-store-positions () + "Stores the current positions for later restore." + + (setq dictionary-positions (cons (point) (window-start)))) + +;; Restore the previous state +(defun dictionary-restore-state (&rest ignored) + "Restore the state just before the last operation" + (let ((position (pop dictionary-position-stack)) + (data (pop dictionary-data-stack))) + (unless position + (error "Already at begin of history")) + (apply (car data) (cdr data)) + (set-window-start (selected-window) (cdr position)) + (goto-char (car position)) + (setq dictionary-current-data data))) + +;; The normal search + +(defun dictionary-new-search (args &optional all) + "Save the current state and start a new search" + (interactive) + (dictionary-store-positions) + (let ((word (car args)) + (dictionary (cdr args))) + + (if all + (setq dictionary dictionary-default-dictionary)) + (dictionary-ensure-buffer) + (dictionary-new-search-internal word dictionary 'dictionary-display-search-result) + (dictionary-store-state 'dictionary-new-search-internal + (list word dictionary 'dictionary-display-search-result)))) + +(defun dictionary-new-search-internal (word dictionary function) + "Starts a new search after preparing the buffer" + (dictionary-pre-buffer) + (dictionary-do-search word dictionary function)) + +(defun dictionary-do-search (word dictionary function &optional nomatching) + "The workhorse for doing the search" + + (message "Searching for %s in %s" word dictionary) + (dictionary-send-command (concat "define " + (dictionary-encode-charset dictionary "") + " \"" + (dictionary-encode-charset word dictionary) + "\"")) + + (message nil) + (let ((reply (dictionary-read-reply-and-split))) + (if (dictionary-check-reply reply 552) + (progn + (unless nomatching + (beep) + (insert "Word not found, maybe you are looking " + "for one of these words\n\n") + (dictionary-do-matching word + dictionary + "." + 'dictionary-display-only-match-result) + (dictionary-post-buffer))) + (if (dictionary-check-reply reply 550) + (error "Dictionary \"%s\" is unknown, please select an existing one." + dictionary) + (unless (dictionary-check-reply reply 150) + (error "Unknown server answer: %s" (dictionary-reply reply))) + (funcall function reply))))) + +(defun dictionary-pre-buffer () + "These commands are executed at the begin of a new buffer" + (setq buffer-read-only nil) + (erase-buffer) + (if dictionary-create-buttons + (progn + (link-insert-link "[Back]" 'dictionary-button-face + 'dictionary-restore-state nil + "Mouse-2 to go backwards in history") + (insert " ") + (link-insert-link "[Search Definition]" + 'dictionary-button-face + 'dictionary-search nil + "Mouse-2 to look up a new word") + (insert " ") + + (link-insert-link "[Matching words]" + 'dictionary-button-face + 'dictionary-match-words nil + "Mouse-2 to find matches for a pattern") + (insert " ") + + (link-insert-link "[Quit]" 'dictionary-button-face + 'dictionary-close nil + "Mouse-2 to close this window") + + (insert "\n ") + + (link-insert-link "[Select Dictionary]" + 'dictionary-button-face + 'dictionary-select-dictionary nil + "Mouse-2 to select dictionary for future searches") + (insert " ") + (link-insert-link "[Select Match Strategy]" + 'dictionary-button-face + 'dictionary-select-strategy nil + "Mouse-2 to select matching algorithm") + (insert "\n\n"))) + (setq dictionary-marker (point-marker))) + +(defun dictionary-post-buffer () + "These commands are executed at the end of a new buffer" + (goto-char dictionary-marker) + + (set-buffer-modified-p nil) + (setq buffer-read-only t)) + +(defun dictionary-display-search-result (reply) + "This function starts displaying the result starting with the `reply'." + + (let ((number (nth 1 (dictionary-reply-list reply)))) + (insert number (if (equal number "1") + " definition" + " definitions") + " found\n\n") + (setq reply (dictionary-read-reply-and-split)) + (while (dictionary-check-reply reply 151) + (let* ((reply-list (dictionary-reply-list reply)) + (dictionary (nth 2 reply-list)) + (description (nth 3 reply-list)) + (word (nth 1 reply-list))) + (dictionary-display-word-entry word dictionary description) + (setq reply (dictionary-read-answer)) + (dictionary-display-word-definition reply word dictionary) + (setq reply (dictionary-read-reply-and-split)))) + (dictionary-post-buffer))) + +(defun dictionary-display-word-entry (word dictionary description) + "Insert an explanation for the current definition." + (let ((start (point))) + (insert "From " + dictionary-description-open-delimiter + (dictionary-decode-charset description dictionary) + dictionary-description-close-delimiter + " [" (dictionary-decode-charset dictionary dictionary) "]:" + "\n\n") + (put-text-property start (point) 'face 'dictionary-word-entry-face))) + +(defun dictionary-display-word-definition (reply word dictionary) + "Insert the definition for the current word" + (let ((start (point))) + (insert (dictionary-decode-charset reply dictionary)) + (insert "\n\n") + (put-text-property start (point) 'face 'dictionary-word-definition-face) + (let ((regexp "\\({+\\)\\([^ '\"][^}]*\\)\\(}+\\)")) + (goto-char start) + (while (< (point) (point-max)) + (if (search-forward-regexp regexp nil t) + (let ((match-start (match-beginning 2)) + (match-end (match-end 2))) + (if dictionary-color-support + ;; Compensate for the replacement + (let ((brace-match-length (- (match-end 1) + (match-beginning 1)))) + (setq match-start (- (match-beginning 2) + brace-match-length)) + (setq match-end (- (match-end 2) + brace-match-length)) + (replace-match "\\2"))) + (dictionary-mark-reference match-start match-end + 'dictionary-new-search + word dictionary)) + (goto-char (point-max))))))) + +(defun dictionary-mark-reference (start end call displayed-word dictionary) + "Format the area from `start' to `end' as link calling `call'. +The word is taken from the buffer, the `dictionary' is given as argument." + (let ((word (buffer-substring-no-properties start end))) + (while (string-match "\n\\s-*" word) + (setq word (replace-match " " t t word))) + (while (string-match "[*\"]" word) + (setq word (replace-match "" t t word))) + + (unless (equal word displayed-word) + (link-create-link start end 'dictionary-reference-face + call (cons word dictionary) + (concat "Press Mouse-2 to lookup \"" + word "\" in \"" dictionary "\""))))) + +(defun dictionary-select-dictionary (&rest ignored) + "Save the current state and start a dictionary selection" + (interactive) + (dictionary-ensure-buffer) + (dictionary-store-positions) + (dictionary-do-select-dictionary) + (dictionary-store-state 'dictionary-do-select-dictionary nil)) + +(defun dictionary-do-select-dictionary (&rest ignored) + "The workhorse for doing the dictionary selection." + + (message "Looking up databases and descriptions") + (dictionary-send-command "show db") + + (let ((reply (dictionary-read-reply-and-split))) + (message nil) + (if (dictionary-check-reply reply 554) + (error "No dictionary present") + (unless (dictionary-check-reply reply 110) + (error "Unknown server answer: %s" + (dictionary-reply reply))) + (dictionary-display-dictionarys reply)))) + +(defun dictionary-simple-split-string (string &optional pattern) + "Return a list of substrings of STRING which are separated by PATTERN. +If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." + (or pattern + (setq pattern "[ \f\t\n\r\v]+")) + ;; The FSF version of this function takes care not to cons in case + ;; of infloop. Maybe we should synch? + (let (parts (start 0)) + (while (string-match pattern string start) + (setq parts (cons (substring string start (match-beginning 0)) parts) + start (match-end 0))) + (nreverse (cons (substring string start) parts)))) + +(defun dictionary-display-dictionarys (reply) + "Handle the display of all dictionaries existing on the server" + (dictionary-pre-buffer) + (insert "Please select your default dictionary:\n\n") + (dictionary-display-dictionary-line "* \"All dictionaries\"") + (dictionary-display-dictionary-line "! \"The first matching dictionary\"") + (let* ((reply (dictionary-read-answer)) + (list (dictionary-simple-split-string reply "\n+"))) + (mapc 'dictionary-display-dictionary-line list)) + (dictionary-post-buffer)) + +(defun dictionary-display-dictionary-line (string) + "Display a single dictionary" + (let* ((list (dictionary-split-string string)) + (dictionary (car list)) + (description (cadr list)) + (translated (dictionary-decode-charset description dictionary))) + (if dictionary + (if (equal dictionary "--exit--") + (insert "(end of default search list)\n") + (link-insert-link (concat dictionary ": " translated) + 'dictionary-reference-face + 'dictionary-set-dictionary + (cons dictionary description) + "Mouse-2 to select this dictionary") + (insert "\n"))))) + +(defun dictionary-set-dictionary (param &optional more) + "Select this dictionary as new default" + + (if more + (dictionary-display-more-info param) + (let ((dictionary (car param))) + (setq dictionary-default-dictionary dictionary) + (dictionary-restore-state) + (message "Dictionary %s has been selected" dictionary)))) + +(defun dictionary-display-more-info (param) + "Display the available information on the dictionary" + + (let ((dictionary (car param)) + (description (cdr param))) + (unless (or (equal dictionary "*") + (equal dictionary "!")) + (dictionary-store-positions) + (message "Requesting more information on %s" dictionary) + (dictionary-send-command + (concat "show info " (dictionary-encode-charset dictionary ""))) + (let ((reply (dictionary-read-reply-and-split))) + (message nil) + (if (dictionary-check-reply reply 550) + (error "Dictionary \"%s\" not existing" dictionary) + (unless (dictionary-check-reply reply 112) + (error "Unknown server answer: %s" (dictionary-reply reply))) + (dictionary-pre-buffer) + (insert "Information on dictionary: ") + (link-insert-link description 'dictionary-reference-face + 'dictionary-set-dictionary + (cons dictionary description) + "Mouse-2 to select this dictionary") + (insert "\n\n") + (setq reply (dictionary-read-answer)) + (insert reply) + (dictionary-post-buffer))) + + (dictionary-store-state 'dictionary-display-more-info dictionary)))) + +(defun dictionary-select-strategy (&rest ignored) + "Save the current state and start a strategy selection" + (interactive) + (dictionary-ensure-buffer) + (dictionary-store-positions) + (dictionary-do-select-strategy) + (dictionary-store-state 'dictionary-do-select-strategy nil)) + +(defun dictionary-do-select-strategy () + "The workhorse for doing the strategy selection." + + (message "Request existing matching algorithm") + (dictionary-send-command "show strat") + + (let ((reply (dictionary-read-reply-and-split))) + (message nil) + (if (dictionary-check-reply reply 555) + (error "No strategies available") + (unless (dictionary-check-reply reply 111) + (error "Unknown server answer: %s" + (dictionary-reply reply))) + (dictionary-display-strategies reply)))) + +(defun dictionary-display-strategies (reply) + "Handle the display of all strategies existing on the server" + (dictionary-pre-buffer) + (insert "Please select your default search strategy:\n\n") + (dictionary-display-strategy-line ". \"The servers default\"") + (let* ((reply (dictionary-read-answer)) + (list (dictionary-simple-split-string reply "\n+"))) + (mapc 'dictionary-display-strategy-line list)) + (dictionary-post-buffer)) + +(defun dictionary-display-strategy-line (string) + "Display a single strategy" + (let* ((list (dictionary-split-string string)) + (strategy (car list)) + (description (cadr list))) + (if strategy + (progn + (link-insert-link description 'dictionary-reference-face + 'dictionary-set-strategy strategy + "Mouse-2 to select this matching algorithm") + (insert "\n"))))) + +(defun dictionary-set-strategy (strategy &rest ignored) + "Select this strategy as new default" + (setq dictionary-default-strategy strategy) + (dictionary-restore-state) + (message "Strategy %s has been selected" strategy)) + +(defun dictionary-new-matching (word) + "Run a new matching search on `word'." + (dictionary-ensure-buffer) + (dictionary-store-positions) + (dictionary-do-matching word dictionary-default-dictionary + dictionary-default-strategy + 'dictionary-display-match-result) + (dictionary-store-state 'dictionary-do-matching + (list word dictionary-default-dictionary + dictionary-default-strategy + 'dictionary-display-match-result))) + +(defun dictionary-do-matching (word dictionary strategy function) + "Ask the server about matches to `word' and display it." + + (message "Lookup matching words for %s in %s using %s" + word dictionary strategy) + (dictionary-send-command + (concat "match " (dictionary-encode-charset dictionary "") " " + (dictionary-encode-charset strategy "") " \"" + (dictionary-encode-charset word "") "\"")) + (let ((reply (dictionary-read-reply-and-split))) + (message nil) + (if (dictionary-check-reply reply 550) + (error "Dictionary \"%s\" is invalid" dictionary)) + (if (dictionary-check-reply reply 551) + (error "Strategy \"%s\" is invalid" strategy)) + (if (dictionary-check-reply reply 552) + (error (concat + "No match for \"%s\" with strategy \"%s\" in " + "dictionary \"%s\".") + word strategy dictionary)) + (unless (dictionary-check-reply reply 152) + (error "Unknown server answer: %s" (dictionary-reply reply))) + (funcall function reply))) + +(defun dictionary-display-only-match-result (reply) + "Display the results from the current matches without the headers." + + (let ((number (nth 1 (dictionary-reply-list reply))) + (list (dictionary-simple-split-string (dictionary-read-answer) "\n+"))) + (insert number " matching word" (if (equal number "1") "" "s") + " found\n\n") + (let ((result nil)) + (mapc (lambda (item) + (let* ((list (dictionary-split-string item)) + (dictionary (car list)) + (word (cadr list)) + (hash (assoc dictionary result))) + (if dictionary + (if hash + (setcdr hash (cons word (cdr hash))) + (setq result (cons + (cons dictionary (list word)) + result)))))) + list) + (dictionary-display-match-lines (reverse result))))) + +(defun dictionary-display-match-result (reply) + "Display the results from the current matches." + (dictionary-pre-buffer) + + (let ((number (nth 1 (dictionary-reply-list reply))) + (list (dictionary-simple-split-string (dictionary-read-answer) "\n+"))) + (insert number " matching word" (if (equal number "1") "" "s") + " found\n\n") + (let ((result nil)) + (mapc (lambda (item) + (let* ((list (dictionary-split-string item)) + (dictionary (car list)) + (word (cadr list)) + (hash (assoc dictionary result))) + (if dictionary + (if hash + (setcdr hash (cons word (cdr hash))) + (setq result (cons + (cons dictionary (list word)) + result)))))) + list) + (dictionary-display-match-lines (reverse result)))) + (dictionary-post-buffer)) + +(defun dictionary-display-match-lines (list) + "Display the match lines." + (mapc (lambda (item) + (let ((dictionary (car item)) + (word-list (cdr item))) + (insert "Matches from " dictionary ":\n") + (mapc (lambda (word) + (setq word (dictionary-decode-charset word dictionary)) + (insert " ") + (link-insert-link word + 'dictionary-reference-face + 'dictionary-new-search + (cons word dictionary) + "Mouse-2 to lookup word") + (insert "\n")) (reverse word-list)) + (insert "\n"))) + list)) + +;; Returns a sensible default for dictionary-search: +;; - if region is active returns its contents +;; - otherwise return the word near the point +(defun dictionary-search-default () + (if (use-region-p) + (buffer-substring-no-properties (region-beginning) (region-end)) + (current-word t))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; User callable commands +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;###autoload +(defun dictionary-search (word &optional dictionary) + "Search the `word' in `dictionary' if given or in all if nil. +It presents the word at point as default input and allows editing it." + (interactive + (list (let ((default (dictionary-search-default))) + (read-string (if default + (format "Search word (%s): " default) + "Search word: ") + nil nil default)) + (if current-prefix-arg + (read-string (if dictionary-default-dictionary + (format "Dictionary (%s): " dictionary-default-dictionary) + "Dictionary: ") + nil nil dictionary-default-dictionary) + dictionary-default-dictionary))) + + ;; if called by pressing the button + (unless word + (setq word (read-string "Search word: "))) + ;; just in case non-interactivly called + (unless dictionary + (setq dictionary dictionary-default-dictionary)) + (dictionary-new-search (cons word dictionary))) + +;;;###autoload +(defun dictionary-lookup-definition () + "Unconditionally lookup the word at point." + (interactive) + (dictionary-new-search (cons (current-word) dictionary-default-dictionary))) + +(defun dictionary-previous () + "Go to the previous location in the current buffer" + (interactive) + (unless (dictionary-mode-p) + (error "Current buffer is no dictionary buffer")) + (dictionary-restore-state)) + +(defun dictionary-next-link () + "Place the cursor to the next link." + (interactive) + (let ((pos (link-next-link))) + (if pos + (goto-char pos) + (error "There is no next link")))) + +(defun dictionary-prev-link () + "Place the cursor to the previous link." + (interactive) + (let ((pos (link-prev-link))) + (if pos + (goto-char pos) + (error "There is no previous link")))) + +(defun dictionary-help () + "Display a little help" + (interactive) + (describe-function 'dictionary-mode)) + +;;;###autoload +(defun dictionary-match-words (&optional pattern &rest ignored) + "Search `pattern' in current default dictionary using default strategy." + (interactive) + ;; can't use interactive because of mouse events + (or pattern + (setq pattern (read-string "Search pattern: "))) + (dictionary-new-matching pattern)) + +;;;###autoload +(defun dictionary-mouse-popup-matching-words (event) + "Display entries matching the word at the cursor" + (interactive "e") + (let ((word (save-window-excursion + (save-excursion + (mouse-set-point event) + (current-word))))) + (selected-window) + (dictionary-popup-matching-words word))) + +;;;###autoload +(defun dictionary-popup-matching-words (&optional word) + "Display entries matching the word at the point" + (interactive) + (unless (functionp 'popup-menu) + (error "Sorry, popup menus are not available in this emacs version")) + (dictionary-do-matching (or word (current-word)) + dictionary-default-dictionary + dictionary-default-popup-strategy + 'dictionary-process-popup-replies)) + +(defun dictionary-process-popup-replies (reply) + (let ((number (nth 1 (dictionary-reply-list reply))) + (list (dictionary-simple-split-string (dictionary-read-answer) "\n+"))) + + (let ((result (mapcar (lambda (item) + (let* ((list (dictionary-split-string item)) + (dictionary (car list)) + (word (dictionary-decode-charset + (cadr list) dictionary))) + (message word) + (if (equal word "") + [ "-" nil nil] + (vector (concat "[" dictionary "] " word) + `(dictionary-new-search + '(,word . ,dictionary)) + t )))) + + list))) + (let ((menu (make-sparse-keymap 'dictionary-popup))) + + (easy-menu-define dictionary-mode-map-menu dictionary-mode-map + "Menu used for displaying dictionary popup" + (cons "Matching words" + `(,@result))) + (popup-menu dictionary-mode-map-menu))))) + +;;; Tooltip support + +;; Common to GNU Emacs and XEmacs + +;; Add a mode indicater named "Dict" +(defvar dictionary-tooltip-mode + nil + "Indicates wheather the dictionary tooltip mode is active") +(nconc minor-mode-alist '((dictionary-tooltip-mode " Dict"))) + +(defcustom dictionary-tooltip-dictionary + nil + "This dictionary to lookup words for tooltips" + :group 'dictionary + :type '(choice (const :tag "None" nil) string)) + +(defun dictionary-definition (word &optional dictionary) + (interactive) + (unwind-protect + (let ((dictionary (or dictionary dictionary-default-dictionary))) + (dictionary-do-search word dictionary 'dictionary-read-definition t)) + nil)) + +(defun dictionary-read-definition (reply) + (let ((list (dictionary-simple-split-string (dictionary-read-answer) "\n+"))) + (mapconcat 'identity (cdr list) "\n"))) + +(defconst dictionary-use-balloon-help + (eval-when-compile + (condition-case nil + (require 'balloon-help) + (error nil)))) + +(make-variable-buffer-local 'dictionary-balloon-help-extent) + +(if dictionary-use-balloon-help + (progn + +;; The following definition are only valid for XEmacs with balloon-help + +(defvar dictionary-balloon-help-position nil + "Current position to lookup word") + +(defun dictionary-balloon-help-store-position (event) + (setq dictionary-balloon-help-position (event-point event))) + +(defun dictionary-balloon-help-description (&rest extent) + "Get the word from the cursor and lookup it" + (if dictionary-balloon-help-position + (let ((word (save-window-excursion + (save-excursion + (goto-char dictionary-balloon-help-position) + (current-word))))) + (let ((definition + (dictionary-definition word dictionary-tooltip-dictionary))) + (if definition + (dictionary-decode-charset definition + dictionary-tooltip-dictionary) + nil))))) + +(defvar dictionary-balloon-help-extent nil + "The extent for activating the balloon help") + +;;;###autoload +(defun dictionary-tooltip-mode (&optional arg) + "Display tooltips for the current word" + (interactive "P") + (let* ((on (if arg + (> (prefix-numeric-value arg) 0) + (not dictionary-tooltip-mode)))) + (make-local-variable 'dictionary-tooltip-mode) + (if on + ;; active mode + (progn + ;; remove old extend + (if dictionary-balloon-help-extent + (delete-extent dictionary-balloon-help-extent)) + ;; create new one + (setq dictionary-balloon-help-extent (make-extent (point-min) + (point-max))) + (set-extent-property dictionary-balloon-help-extent + 'balloon-help + 'dictionary-balloon-help-description) + (set-extent-property dictionary-balloon-help-extent + 'start-open nil) + (set-extent-property dictionary-balloon-help-extent + 'end-open nil) + (add-hook 'mouse-motion-hook + 'dictionary-balloon-help-store-position)) + + ;; deactivate mode + (if dictionary-balloon-help-extent + (delete-extent dictionary-balloon-help-extent)) + (remove-hook 'mouse-motion-hook + 'dictionary-balloon-help-store-position)) + (setq dictionary-tooltip-mode on) + (balloon-help-minor-mode on))) + +) ;; end of XEmacs part + +(defvar global-dictionary-tooltip-mode + nil) + +;;; Tooltip support for GNU Emacs +(defun dictionary-display-tooltip (event) + "Search the current word in the `dictionary-tooltip-dictionary'." + (interactive "e") + (if dictionary-tooltip-dictionary + (let ((word (save-window-excursion + (save-excursion + (mouse-set-point event) + (current-word))))) + (let ((definition + (dictionary-definition word dictionary-tooltip-dictionary))) + (if definition + (tooltip-show + (dictionary-decode-charset definition + dictionary-tooltip-dictionary))) + t)) + nil)) + +;;;###autoload +(defun dictionary-tooltip-mode (&optional arg) + "Display tooltips for the current word" + (interactive "P") + (require 'tooltip) + (let ((on (if arg + (> (prefix-numeric-value arg) 0) + (not dictionary-tooltip-mode)))) + (make-local-variable 'dictionary-tooltip-mode) + (setq dictionary-tooltip-mode on) + ;; make sure that tooltip is still (global available) even is on + ;; if nil + (tooltip-mode 1) + (add-hook 'tooltip-hook 'dictionary-display-tooltip) + (make-local-variable 'track-mouse) + (setq track-mouse on))) + +;;;###autoload +(defun global-dictionary-tooltip-mode (&optional arg) + "Enable/disable dictionary-tooltip-mode for all buffers" + (interactive "P") + (require 'tooltip) + (let* ((on (if arg (> (prefix-numeric-value arg) 0) + (not global-dictionary-tooltip-mode))) + (hook-fn (if on 'add-hook 'remove-hook))) + (setq global-dictionary-tooltip-mode on) + (tooltip-mode 1) + (funcall hook-fn 'tooltip-hook 'dictionary-display-tooltip) + (setq-default dictionary-tooltip-mode on) + (setq-default track-mouse on))) + +) ;; end of GNU Emacs part + +(provide 'dictionary) + +;;; dictionary.el ends here diff --git a/lisp/net/link.el b/lisp/net/link.el new file mode 100644 index 0000000000..30eadb1017 --- /dev/null +++ b/lisp/net/link.el @@ -0,0 +1,129 @@ +;;; link.el --- Hypertext links in text buffers + +;; Author: Torsten Hilbrich +;; Keywords: interface, hypermedia +;; Version: 1.11 + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This file contains functions for using links in buffers. A link is +;; a part of the buffer marked with a special face, beeing +;; hightlighted while the mouse points to it and beeing activated when +;; pressing return or clicking the button2. + +;; Which each link a function and some data are associated. Upon +;; clicking the function is called with the data as only +;; argument. Both the function and the data are stored in text +;; properties. +;; +;; link-create-link - insert a new link for the text in the given range +;; link-initialize-keymap - install the keybinding for selecting links + +;;; Code: + +(eval-when-compile + (require 'cl)) + +(defun link-create-link (start end face function &optional data help) + "Create a link in the current buffer starting from `start' going to `end'. +The `face' is used for displaying, the `data' are stored together with the +link. Upon clicking the `function' is called with `data' as argument." + (let ((properties `(face ,face + mouse-face highlight + link t + link-data ,data + help-echo ,help + link-function ,function))) + (remove-text-properties start end properties) + (add-text-properties start end properties))) + +(defun link-insert-link (text face function &optional data help) + "Insert the `text' at point to be formatted as link. +The `face' is used for displaying, the `data' are stored together with the +link. Upon clicking the `function' is called with `data' as argument." + (let ((start (point))) + (insert text) + (link-create-link start (point) face function data help))) + +(defun link-selected (&optional all) + "Is called upon clicking or otherwise visiting the link." + (interactive) + + (let* ((properties (text-properties-at (point))) + (function (plist-get properties 'link-function)) + (data (plist-get properties 'link-data))) + (if function + (funcall function data all)))) + +(defun link-selected-all () + "Called for meta clicking the link" + (interactive) + (link-selected 'all)) + +(defun link-mouse-click (event &optional all) + "Is called upon clicking the link." + (interactive "@e") + + (mouse-set-point event) + (link-selected)) + +(defun link-mouse-click-all (event) + "Is called upon meta clicking the link." + (interactive "@e") + + (mouse-set-point event) + (link-selected-all)) + +(defun link-next-link () + "Return the position of the next link or nil if there is none" + (let* ((pos (point)) + (pos (next-single-property-change pos 'link))) + (if pos + (if (text-property-any pos (min (1+ pos) (point-max)) 'link t) + pos + (next-single-property-change pos 'link)) + nil))) + + +(defun link-prev-link () + "Return the position of the previous link or nil if there is none" + (let* ((pos (point)) + (pos (previous-single-property-change pos 'link))) + (if pos + (if (text-property-any pos (1+ pos) 'link t) + pos + (let ((val (previous-single-property-change pos 'link))) + (if val + val + (text-property-any (point-min) (1+ (point-min)) 'link t)))) + nil))) + +(defun link-initialize-keymap (keymap) + "Defines the necessary bindings inside keymap" + + (if (and (boundp 'running-xemacs) running-xemacs) + (progn + (define-key keymap [button2] 'link-mouse-click) + (define-key keymap [(meta button2)] 'link-mouse-click-all)) + (define-key keymap [mouse-2] 'link-mouse-click) + (define-key keymap [M-mouse-2] 'link-mouse-click-all)) + (define-key keymap "\r" 'link-selected) + (define-key keymap "\M-\r" 'link-selected-all)) + +(provide 'link) +;;; link.el ends here