diff options
author | Matthew Kosarek <mattkae@protonmail.com> | 2022-07-28 08:25:48 -0400 |
---|---|---|
committer | Matthew Kosarek <mattkae@protonmail.com> | 2022-07-28 08:25:48 -0400 |
commit | fadb4ec682b0083291c49260f798999a4d70400a (patch) | |
tree | 28018a75981111c5fe97dd46581e11318f4eb583 /lisp | |
parent | ed804295d8c266e77574b51a49328b56cb9abdde (diff) | |
parent | 928759bb7a2f91dbf76a55bedc44e25638cd2419 (diff) |
Merge branch 'master' of matthewkosarek.xyz:/srv/git/emacs_config
Diffstat (limited to 'lisp')
-rw-r--r-- | lisp/cpp.el | 25 | ||||
-rw-r--r-- | lisp/flyspell.el | 2466 | ||||
-rw-r--r-- | lisp/general.el | 44 | ||||
-rw-r--r-- | lisp/js-mode-custom.el | 19 | ||||
-rw-r--r-- | lisp/smooth-scrolling.el | 327 | ||||
-rw-r--r-- | lisp/text.el | 5 |
6 files changed, 2530 insertions, 356 deletions
diff --git a/lisp/cpp.el b/lisp/cpp.el index 448b3a3..dd32022 100644 --- a/lisp/cpp.el +++ b/lisp/cpp.el @@ -1,3 +1,6 @@ +;;; package --- Summary + +;;; Code: (defun setup-c() (setq c++-tab-always-indent 0) (setq c-basic-offset 4) ;; Default is 2 @@ -29,29 +32,7 @@ (add-hook 'irony-mode-hook 'irony-cdb-autosetup-compile-options) ) -;; == company-mode == -(use-package company - :ensure t - :defer t - :init (add-hook 'after-init-hook 'global-company-mode) - :config - (use-package company-irony :ensure t :defer t) - (setq company-idle-delay nil - company-minimum-prefix-length 2 - company-show-numbers t - company-tooltip-limit 20 - company-dabbrev-downcase nil - company-backends '((company-irony company-gtags)) - ) - :bind ("C-;" . company-complete-common) - ) - -;; Flycheck -(eval-after-load 'flycheck - '(add-hook 'flycheck-mode-hook #'flycheck-irony-setup)) - (require 'cmake-ide) (cmake-ide-setup) - (provide 'cpp) diff --git a/lisp/flyspell.el b/lisp/flyspell.el new file mode 100644 index 0000000..ef4c505 --- /dev/null +++ b/lisp/flyspell.el @@ -0,0 +1,2466 @@ +;;; <pre> +;;; flyspell.el --- on-the-fly spell checker + +;; Copyright (C) 1998, 2000, 2003, 2004, 2005 Free Software Foundation, Inc. + +;; Author: Manuel Serrano <Manuel.Serrano@inria.fr> +;; Version: 1.7q +;; Keywords: convenience + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: +;; +;; Flyspell is a minor Emacs mode performing on-the-fly spelling +;; checking. +;; +;; To enable Flyspell minor mode, type M-x flyspell-mode. +;; This applies only to the current buffer. +;; +;; To enable Flyspell in text representing computer programs, type +;; M-x flyspell-prog-mode. +;; In that mode only text inside comments is checked. +;; +;; Note: consider setting the variable ispell-parser to `tex' to +;; avoid TeX command checking; use `(setq ispell-parser 'tex)'. +;; +;; Some user variables control the behavior of flyspell. They are +;; those defined under the `User variables' comment. + +;;; Code: +(require 'ispell) + +;*---------------------------------------------------------------------*/ +;* Group ... */ +;*---------------------------------------------------------------------*/ +(defgroup flyspell nil + "Spell checking on the fly." + :tag "FlySpell" + :prefix "flyspell-" + :group 'ispell + :group 'processes) + +;*---------------------------------------------------------------------*/ +;* Which emacs are we currently running */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-emacs + (cond + ((string-match "XEmacs" emacs-version) + 'xemacs) + (t + 'emacs)) + "The type of Emacs we are currently running.") + +(defvar flyspell-use-local-map + (or (eq flyspell-emacs 'xemacs) + (not (string< emacs-version "20")))) + +;*---------------------------------------------------------------------*/ +;* User configuration ... */ +;*---------------------------------------------------------------------*/ +(defcustom flyspell-highlight-flag t + "*How Flyspell should indicate misspelled words. +Non-nil means use highlight, nil means use minibuffer messages." + :group 'flyspell + :type 'boolean) + +(defcustom flyspell-mark-duplications-flag t + "*Non-nil means Flyspell reports a repeated word as an error." + :group 'flyspell + :type 'boolean) + +(defcustom flyspell-sort-corrections nil + "*Non-nil means, sort the corrections alphabetically before popping them." + :group 'flyspell + :version "21.1" + :type 'boolean) + +(defcustom flyspell-duplicate-distance -1 + "*The maximum distance for finding duplicates of unrecognized words. +This applies to the feature that when a word is not found in the dictionary, +if the same spelling occurs elsewhere in the buffer, +Flyspell uses a different face (`flyspell-duplicate-face') to highlight it. +This variable specifies how far to search to find such a duplicate. +-1 means no limit (search the whole buffer). +0 means do not search for duplicate unrecognized spellings." + :group 'flyspell + :version "21.1" + :type 'number) + +(defcustom flyspell-delay 3 + "*The number of seconds to wait before checking, after a \"delayed\" command." + :group 'flyspell + :type 'number) + +(defcustom flyspell-persistent-highlight t + "*Non-nil means misspelled words remain highlighted until corrected. +If this variable is nil, only the most recently detected misspelled word +is highlighted." + :group 'flyspell + :type 'boolean) + +(defcustom flyspell-highlight-properties t + "*Non-nil means highlight incorrect words even if a property exists for this word." + :group 'flyspell + :type 'boolean) + +(defcustom flyspell-default-delayed-commands + '(self-insert-command + delete-backward-char + backward-or-forward-delete-char + delete-char + scrollbar-vertical-drag + backward-delete-char-untabify) + "The standard list of delayed commands for Flyspell. +See `flyspell-delayed-commands'." + :group 'flyspell + :version "21.1" + :type '(repeat (symbol))) + +(defcustom flyspell-delayed-commands nil + "List of commands that are \"delayed\" for Flyspell mode. +After these commands, Flyspell checking is delayed for a short time, +whose length is specified by `flyspell-delay'." + :group 'flyspell + :type '(repeat (symbol))) + +(defcustom flyspell-default-deplacement-commands + '(next-line + previous-line + scroll-up + scroll-down) + "The standard list of deplacement commands for Flyspell. +See `flyspell-deplacement-commands'." + :group 'flyspell + :version "21.1" + :type '(repeat (symbol))) + +(defcustom flyspell-default-ignored-commands + '(fill-paragraph) + "The standard list of ignored commands for Flyspell. + See `flyspell-delayed-commands'." + :group 'flyspell + :version "21.3" + :type '(repeat (symbol))) + + (defcustom flyspell-ignored-commands nil + "List of commands that are \"ignored\" for Flyspell mode. + The changes in the text made by these commands are ignored. This list is meant for commands that change text in a way that does not affect individual words, such as `fill-paragraph'." + :group 'flyspell + :version "21.3" + :type '(repeat (symbol))) + +(defcustom flyspell-deplacement-commands nil + "List of commands that are \"deplacement\" for Flyspell mode. +After these commands, Flyspell checking is performed only if the previous +command was not the very same command." + :group 'flyspell + :version "21.1" + :type '(repeat (symbol))) + +(defcustom flyspell-issue-welcome-flag t + "*Non-nil means that Flyspell should display a welcome message when started." + :group 'flyspell + :type 'boolean) + +(defcustom flyspell-issue-message-flag t + "*Non-nil means that Flyspell emits messages when checking words." + :group 'flyspell + :type 'boolean) + +(defcustom flyspell-incorrect-hook nil + "*List of functions to be called when incorrect words are encountered. +Each function is given three arguments: the beginning and the end +of the incorrect region. The third is either the symbol 'doublon' or the list +of possible corrections as returned by 'ispell-parse-output'. + +If any of the functions return non-Nil, the word is not highlighted as +incorrect." + :group 'flyspell + :version "21.1" + :type 'hook) + +(defcustom flyspell-default-dictionary nil + "A string that is the name of the default dictionary. +This is passed to the `ispell-change-dictionary' when flyspell is started. +If the variable `ispell-local-dictionary' or `ispell-dictionary' is non-nil +when flyspell is started, the value of that variable is used instead +of `flyspell-default-dictionary' to select the default dictionary. +Otherwise, if `flyspell-default-dictionary' is nil, it means to use +Ispell's ultimate default dictionary." + :group 'flyspell + :version "21.1" + :type '(choice string (const :tag "Default" nil))) + +(defcustom flyspell-tex-command-regexp + "\\(\\(begin\\|end\\)[ \t]*{\\|\\(cite[a-z*]*\\|label\\|ref\\|eqref\\|usepackage\\|documentclass\\)[ \t]*\\(\\[[^]]*\\]\\)?{[^{}]*\\)" + "A string that is the regular expression that matches TeX commands." + :group 'flyspell + :version "21.1" + :type 'string) + +(defcustom flyspell-check-tex-math-command nil + "*Non nil means check even inside TeX math environment. +TeX math environments are discovered by the TEXMATHP that implemented +inside the texmathp.el Emacs package. That package may be found at: +http://strw.leidenuniv.nl/~dominik/Tools" + :group 'flyspell + :type 'boolean) + +(defcustom flyspell-dictionaries-that-consider-dash-as-word-delimiter + '("francais" "deutsch8" "norsk") + "List of dictionary names that consider `-' as word delimiter." + :group 'flyspell + :version "21.1" + :type '(repeat (string))) + +(defcustom flyspell-abbrev-p + nil + "*If non-nil, add correction to abbreviation table." + :group 'flyspell + :version "21.1" + :type 'boolean) + +(defcustom flyspell-use-global-abbrev-table-p + nil + "*If non-nil, prefer global abbrev table to local abbrev table." + :group 'flyspell + :version "21.1" + :type 'boolean) + +(defcustom flyspell-list-command + "-l" + "String used to indicate ispell to return a list of missspelled words." + :group 'flyspell + :type 'string) + +;;;###autoload +(defcustom flyspell-mode-line-string " Fly" + "*String displayed on the modeline when flyspell is active. +Set this to nil if you don't want a modeline indicator." + :group 'flyspell + :type '(choice string (const :tag "None" nil))) + +(defcustom flyspell-large-region 1000 + "*The threshold that determines if a region is small. +The `flyspell-region' function is invoked if the region is small, the +word are checked one after the other using regular flyspell check +means. If the region is large, a new Ispell process is spawned to get +speed. + +if flyspell-large-region is nil, regions are treated as small." + :group 'flyspell + :version "21.1" + :type '(choice number boolean)) + +(defcustom flyspell-insert-function (function insert) + "*Function for inserting word by flyspell upon correction." + :group 'flyspell + :type 'function) + +(defcustom flyspell-before-incorrect-word-string nil + "String used to indicate an incorrect word starting." + :group 'flyspell + :type '(choice string (const nil))) + +(defcustom flyspell-after-incorrect-word-string nil + "String used to indicate an incorrect word ending." + :group 'flyspell + :type '(choice string (const nil))) + +(defcustom flyspell-use-meta-tab t + "*Non-nil means that flyspell uses META-TAB to correct word." + :group 'flyspell + :type 'boolean) + +(defcustom flyspell-auto-correct-binding + (cond + ((eq flyspell-emacs 'xemacs) + [(control \;)]) + (t + [?\C-\;])) + "The key binding for flyspell auto correction." + :group 'flyspell) + +;*---------------------------------------------------------------------*/ +;* Mode specific options */ +;* ------------------------------------------------------------- */ +;* Mode specific options enable users to disable flyspell on */ +;* certain word depending of the emacs mode. For instance, when */ +;* using flyspell with mail-mode add the following expression */ +;* in your .emacs file: */ +;* (add-hook 'mail-mode */ +;* '(lambda () (setq flyspell-generic-check-word-p */ +;* 'mail-mode-flyspell-verify))) */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-generic-check-word-p nil + "Function providing per-mode customization over which words are flyspelled. +Returns t to continue checking, nil otherwise. +Flyspell mode sets this variable to whatever is the `flyspell-mode-predicate' +property of the major mode name.") +(make-variable-buffer-local 'flyspell-generic-check-word-p) + +;*--- mail mode -------------------------------------------------------*/ +(put 'mail-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify) +(put 'message-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify) +(defun mail-mode-flyspell-verify () + "This function is used for `flyspell-generic-check-word-p' in Mail mode." + (let ((header-end (save-excursion + (goto-char (point-min)) + (re-search-forward + (concat "^" + (regexp-quote mail-header-separator) + "$") + nil t) + (point))) + (signature-begin (save-excursion + (goto-char (point-max)) + (re-search-backward message-signature-separator + nil t) + (point)))) + (cond ((< (point) header-end) + (and (save-excursion (beginning-of-line) + (looking-at "^Subject:")) + (> (point) (match-end 0)))) + ((> (point) signature-begin) + nil) + (t + (save-excursion + (beginning-of-line) + (not (looking-at "[>}|]\\|To:"))))))) + +;*--- texinfo mode ----------------------------------------------------*/ +(put 'texinfo-mode 'flyspell-mode-predicate 'texinfo-mode-flyspell-verify) +(defun texinfo-mode-flyspell-verify () + "This function is used for `flyspell-generic-check-word-p' in Texinfo mode." + (save-excursion + (forward-word -1) + (not (looking-at "@")))) + +;*--- tex mode --------------------------------------------------------*/ +(put 'tex-mode 'flyspell-mode-predicate 'tex-mode-flyspell-verify) +(defun tex-mode-flyspell-verify () + "This function is used for `flyspell-generic-check-word-p' in LaTeX mode." + (and + (not (save-excursion + (re-search-backward "^[ \t]*%%%[ \t]+Local" (point-min) t))) + (not (save-excursion + (let ((this (point-marker)) + (e (progn (end-of-line) (point-marker)))) + (beginning-of-line) + (if (re-search-forward "\\\\\\(cite\\|label\\|ref\\){[^}]*}" e t) + (and (>= this (match-beginning 0)) + (<= this (match-end 0)) ))))))) + +;*--- sgml mode -------------------------------------------------------*/ +(put 'sgml-mode 'flyspell-mode-predicate 'sgml-mode-flyspell-verify) +(put 'html-mode 'flyspell-mode-predicate 'sgml-mode-flyspell-verify) + +(defun sgml-mode-flyspell-verify () + "This function is used for `flyspell-generic-check-word-p' in SGML mode." + (not (save-excursion + (let ((this (point-marker)) + (s (progn (beginning-of-line) (point-marker))) + (e (progn (end-of-line) (point-marker)))) + (or (progn + (goto-char this) + (and (re-search-forward "[^<]*>" e t) + (= (match-beginning 0) this))) + (progn + (goto-char this) + (and (re-search-backward "<[^>]*" s t) + (= (match-end 0) this))) + (and (progn + (goto-char this) + (and (re-search-forward "[^&]*;" e t) + (= (match-beginning 0) this))) + (progn + (goto-char this) + (and (re-search-backward "&[^;]*" s t) + (= (match-end 0) this))))))))) + +;*---------------------------------------------------------------------*/ +;* Programming mode */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-prog-text-faces + '(font-lock-string-face font-lock-comment-face font-lock-doc-face) + "Faces corresponding to text in programming-mode buffers.") + +(defun flyspell-generic-progmode-verify () + "Used for `flyspell-generic-check-word-p' in programming modes." + (let ((f (get-text-property (point) 'face))) + (memq f flyspell-prog-text-faces))) + +;;;###autoload +(defun flyspell-prog-mode () + "Turn on `flyspell-mode' for comments and strings." + (interactive) + (setq flyspell-generic-check-word-p 'flyspell-generic-progmode-verify) + (flyspell-mode 1) + (run-hooks 'flyspell-prog-mode-hook)) + +;*---------------------------------------------------------------------*/ +;* Overlay compatibility */ +;*---------------------------------------------------------------------*/ +(autoload 'make-overlay "overlay" "Overlay compatibility kit." t) +(autoload 'overlayp "overlay" "Overlay compatibility kit." t) +(autoload 'overlays-in "overlay" "Overlay compatibility kit." t) +(autoload 'delete-overlay "overlay" "Overlay compatibility kit." t) +(autoload 'overlays-at "overlay" "Overlay compatibility kit." t) +(autoload 'overlay-put "overlay" "Overlay compatibility kit." t) +(autoload 'overlay-get "overlay" "Overlay compatibility kit." t) +(autoload 'previous-overlay-change "overlay" "Overlay compatibility kit." t) + +;*---------------------------------------------------------------------*/ +;* The minor mode declaration. */ +;*---------------------------------------------------------------------*/ +(eval-when-compile (defvar flyspell-local-mouse-map)) + +;;;###autoload +(defvar flyspell-mode nil) +(make-variable-buffer-local 'flyspell-mode) + +(defvar flyspell-mouse-map + (let ((map (make-sparse-keymap))) + (if flyspell-use-meta-tab + (define-key map "\M-\t" #'flyspell-auto-correct-word)) + (define-key map (if (featurep 'xemacs) [button2] [down-mouse-2]) + #'flyspell-correct-word) + (if (not (featurep 'xemacs)) + (define-key map [(shift down-mouse-2)] #'flyspell-correct-word)) + (define-key map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word) + (define-key map [(control \,)] 'flyspell-goto-next-error) + (define-key map [(control \.)] 'flyspell-auto-correct-word) + map)) + +;;;###autoload +(defvar flyspell-mode-map (make-sparse-keymap)) + +;; mouse, keyboard bindings and misc definition +(when (or (assoc 'flyspell-mode minor-mode-map-alist) + (setq minor-mode-map-alist + (cons (cons 'flyspell-mode flyspell-mode-map) + minor-mode-map-alist))) + (if flyspell-use-meta-tab + (define-key flyspell-mode-map "\M-\t" 'flyspell-auto-correct-word)) + (cond + ((eq flyspell-emacs 'xemacs) + (define-key flyspell-mode-map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word) + (define-key flyspell-mode-map [(control \,)] 'flyspell-goto-next-error) + (define-key flyspell-mode-map [(control \.)] 'flyspell-auto-correct-word)) + (flyspell-use-local-map + (define-key flyspell-mode-map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word) + (define-key flyspell-mode-map [?\C-\,] 'flyspell-goto-next-error) + (define-key flyspell-mode-map [?\C-\.] 'flyspell-auto-correct-word)))) + + +;; the name of the overlay property that defines the keymap +(defvar flyspell-overlay-keymap-property-name 'keymap) + +;; dash character machinery +(defvar flyspell-consider-dash-as-word-delimiter-flag nil + "*Non-nil means that the `-' char is considered as a word delimiter.") +(make-variable-buffer-local 'flyspell-consider-dash-as-word-delimiter-flag) +(defvar flyspell-dash-dictionary nil) +(make-variable-buffer-local 'flyspell-dash-dictionary) +(defvar flyspell-dash-local-dictionary nil) +(make-variable-buffer-local 'flyspell-dash-local-dictionary) + +;*---------------------------------------------------------------------*/ +;* Highlighting */ +;*---------------------------------------------------------------------*/ +(defface flyspell-incorrect-face + (if (eq flyspell-emacs 'xemacs) + '((((class color)) (:foreground "OrangeRed" :bold t :underline t)) + (t (:bold t))) + '((((class color)) (:foreground "OrangeRed" :weight bold :underline t)) + (t (:weight bold)))) + "Face used for marking a misspelled word in Flyspell." + :group 'flyspell) + +(defface flyspell-duplicate-face + (if (eq flyspell-emacs 'xemacs) + '((((class color)) (:foreground "Gold3" :bold t :underline t)) + (t (:bold t))) + '((((class color)) (:foreground "Gold3" :weight bold :underline t)) + (t (:weight bold)))) + "Face used for marking a misspelled word that appears twice in the buffer. +See also `flyspell-duplicate-distance'." + :group 'flyspell) + +(defvar flyspell-overlay nil) + +;*---------------------------------------------------------------------*/ +;* flyspell-mode ... */ +;*---------------------------------------------------------------------*/ +;;;###autoload +(defun flyspell-mode (&optional arg) + "Minor mode performing on-the-fly spelling checking. +Ispell is automatically spawned on background for each entered words. +The default flyspell behavior is to highlight incorrect words. +With no argument, this command toggles Flyspell mode. +With a prefix argument ARG, turn Flyspell minor mode on iff ARG is positive. + +Bindings: +\\[ispell-word]: correct words (using Ispell). +\\[flyspell-auto-correct-word]: automatically correct word. +\\[flyspell-auto-correct-previous-word]: automatically correct the last misspelled word. +\\[flyspell-correct-word] (or down-mouse-2): popup correct words. + +Hooks: +This runs `flyspell-mode-hook' after flyspell is entered. + +Remark: +`flyspell-mode' uses `ispell-mode'. Thus all Ispell options are +valid. For instance, a personal dictionary can be used by +invoking `ispell-change-dictionary'. + +Consider using the `ispell-parser' to check your text. For instance +consider adding: +\(add-hook 'tex-mode-hook (function (lambda () (setq ispell-parser 'tex)))) +in your .emacs file. + +\\[flyspell-region] checks all words inside a region. +\\[flyspell-buffer] checks the whole buffer." + (interactive "P") + (let ((old-flyspell-mode flyspell-mode)) + ;; Mark the mode as on or off. + (setq flyspell-mode (not (or (and (null arg) flyspell-mode) + (<= (prefix-numeric-value arg) 0)))) + ;; Do the real work. + (unless (eq flyspell-mode old-flyspell-mode) + (if flyspell-mode + (flyspell-mode-on) + (flyspell-mode-off)) + ;; Force modeline redisplay. + (set-buffer-modified-p (buffer-modified-p))))) + +;*---------------------------------------------------------------------*/ +;* Autoloading */ +;*---------------------------------------------------------------------*/ +;;;###autoload +(if (fboundp 'add-minor-mode) + (add-minor-mode 'flyspell-mode + 'flyspell-mode-line-string + flyspell-mode-map + nil + 'flyspell-mode) + (or (assoc 'flyspell-mode minor-mode-alist) + (setq minor-mode-alist + (cons '(flyspell-mode flyspell-mode-line-string) + minor-mode-alist))) + + (or (assoc 'flyspell-mode minor-mode-map-alist) + (setq minor-mode-map-alist + (cons (cons 'flyspell-mode flyspell-mode-map) + minor-mode-map-alist)))) + +;*---------------------------------------------------------------------*/ +;* flyspell-buffers ... */ +;* ------------------------------------------------------------- */ +;* For remembering buffers running flyspell */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-buffers nil) + +;*---------------------------------------------------------------------*/ +;* flyspell-minibuffer-p ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-minibuffer-p (buffer) + "Is BUFFER a minibuffer?" + (let ((ws (get-buffer-window-list buffer t))) + (and (consp ws) (window-minibuffer-p (car ws))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-version ... */ +;*---------------------------------------------------------------------*/ +;;;###autoload +(defun flyspell-version () + "The flyspell version" + (interactive) + "1.7q") + +;*---------------------------------------------------------------------*/ +;* flyspell-accept-buffer-local-defs ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-accept-buffer-local-defs () + ;; strange problem. If buffer in current window has font-lock turned on, + ;; but SET-BUFFER was called to point to an invisible buffer, this ispell + ;; call will reset the buffer to the buffer in the current window. However, + ;; it only happens at startup (fix by Albert L. Ting). + (let ((buf (current-buffer))) + (ispell-accept-buffer-local-defs) + (set-buffer buf)) + (if (not (and (eq flyspell-dash-dictionary ispell-dictionary) + (eq flyspell-dash-local-dictionary ispell-local-dictionary))) + ;; the dictionary has changed + (progn + (setq flyspell-dash-dictionary ispell-dictionary) + (setq flyspell-dash-local-dictionary ispell-local-dictionary) + (if (member (or ispell-local-dictionary ispell-dictionary) + flyspell-dictionaries-that-consider-dash-as-word-delimiter) + (setq flyspell-consider-dash-as-word-delimiter-flag t) + (setq flyspell-consider-dash-as-word-delimiter-flag nil))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-mode-on ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-mode-on () + "Turn Flyspell mode on. Do not use this; use `flyspell-mode' instead." + (setq ispell-highlight-face 'flyspell-incorrect-face) + ;; local dictionaries setup + (ispell-change-dictionary + (or ispell-local-dictionary ispell-dictionary flyspell-default-dictionary)) + ;; we have to force ispell to accept the local definition or + ;; otherwise it could be too late, the local dictionary may + ;; be forgotten! + (flyspell-accept-buffer-local-defs) + ;; we put the `flyspell-delayed' property on some commands + (flyspell-delay-commands) + ;; we put the `flyspell-deplacement' property on some commands + (flyspell-deplacement-commands) + ;; we put the `flyspell-ignored' property on some commands + (flyspell-ignore-commands) + ;; we bound flyspell action to post-command hook + (if (eq flyspell-emacs 'xemacs) + (make-local-hook 'post-command-hook)) + (add-hook 'post-command-hook (function flyspell-post-command-hook) t t) + ;; we bound flyspell action to pre-command hook + (if (eq flyspell-emacs 'xemacs) + (make-local-hook 'pre-command-hook)) + (add-hook 'pre-command-hook (function flyspell-pre-command-hook) t t) + ;; we bound flyspell action to after-change hook + (make-local-variable 'after-change-functions) + (setq after-change-functions + (cons 'flyspell-after-change-function after-change-functions)) + ;; set flyspell-generic-check-word-p based on the major mode + (let ((mode-predicate (get major-mode 'flyspell-mode-predicate))) + (if mode-predicate + (setq flyspell-generic-check-word-p mode-predicate))) + ;; work around the fact that the `local-map' text-property replaces the + ;; buffer's local map rather than shadowing it. + (set (make-local-variable 'flyspell-mouse-map) + (let ((map (copy-keymap flyspell-mouse-map))) + (set-keymap-parent map (current-local-map)) + (if (and (eq flyspell-emacs 'emacs) + (not (string< emacs-version "20"))) + (define-key map '[tool-bar] nil)) + map)) + (set (make-local-variable 'flyspell-mode-map) + (let ((map (copy-keymap flyspell-mode-map))) + (set-keymap-parent map (current-local-map)) + (if (and (eq flyspell-emacs 'emacs) + (not (string< emacs-version "20"))) + (define-key map '[tool-bar] nil)) + map)) + ;; the welcome message + (if (and flyspell-issue-message-flag + flyspell-issue-welcome-flag + (interactive-p)) + (let ((binding (where-is-internal 'flyspell-auto-correct-word + nil 'non-ascii))) + (message + (if binding + (format "Welcome to flyspell. Use %s or Mouse-2 to correct words." + (key-description binding)) + "Welcome to flyspell. Use Mouse-2 to correct words.")))) + ;; we end with the flyspell hooks + (run-hooks 'flyspell-mode-hook)) + +;*---------------------------------------------------------------------*/ +;* flyspell-delay-commands ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-delay-commands () + "Install the standard set of Flyspell delayed commands." + (mapcar 'flyspell-delay-command flyspell-default-delayed-commands) + (mapcar 'flyspell-delay-command flyspell-delayed-commands)) + +;*---------------------------------------------------------------------*/ +;* flyspell-delay-command ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-delay-command (command) + "Set COMMAND to be delayed, for Flyspell. +When flyspell `post-command-hook' is invoked because a delayed command +as been used the current word is not immediately checked. +It will be checked only after `flyspell-delay' seconds." + (interactive "SDelay Flyspell after Command: ") + (put command 'flyspell-delayed t)) + +;*---------------------------------------------------------------------*/ +;* flyspell-deplacement-commands ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-deplacement-commands () + "Install the standard set of Flyspell deplacement commands." + (mapcar 'flyspell-deplacement-command flyspell-default-deplacement-commands) + (mapcar 'flyspell-deplacement-command flyspell-deplacement-commands)) + +;*---------------------------------------------------------------------*/ +;* flyspell-deplacement-command ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-deplacement-command (command) + "Set COMMAND that implement cursor movements, for Flyspell. +When flyspell `post-command-hook' is invoked because of a deplacement command +as been used the current word is checked only if the previous command was +not the very same deplacement command." + (interactive "SDeplacement Flyspell after Command: ") + (put command 'flyspell-deplacement t)) + +;*---------------------------------------------------------------------*/ +;* flyspell-ignore-commands ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-ignore-commands () + "Install the standard set of Flyspell ignored commands." + (mapcar 'flyspell-ignore-command flyspell-default-ignored-commands) + (mapcar 'flyspell-ignore-command flyspell-ignored-commands)) + +;*---------------------------------------------------------------------*/ +;* flyspell-ignore-command ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-ignore-command (command) + "Set COMMAND to be ignored, for Flyspell. +When flyspell `post-command-hook' is invoked because of an +ignored command having been used, the changes in the text made by +that command are ignored. This feature is meant for commands that +change text in a way that does not affect individual words, such +as `fill-paragraph'." + (interactive "SMake Flyspell ignore changes made by Command: ") + (put command 'flyspell-ignored t)) + +;*---------------------------------------------------------------------*/ +;* flyspell-word-cache ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-word-cache-start nil) +(defvar flyspell-word-cache-end nil) +(defvar flyspell-word-cache-word nil) +(defvar flyspell-word-cache-result '_) +(make-variable-buffer-local 'flyspell-word-cache-start) +(make-variable-buffer-local 'flyspell-word-cache-end) +(make-variable-buffer-local 'flyspell-word-cache-word) +(make-variable-buffer-local 'flyspell-word-cache-result) + +;*---------------------------------------------------------------------*/ +;* The flyspell pre-hook, store the current position. In the */ +;* post command hook, we will check, if the word at this position */ +;* has to be spell checked. */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-pre-buffer nil) +(defvar flyspell-pre-point nil) +(defvar flyspell-pre-column nil) +(defvar flyspell-pre-pre-buffer nil) +(defvar flyspell-pre-pre-point nil) + +;*---------------------------------------------------------------------*/ +;* flyspell-previous-command ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-previous-command nil + "The last interactive command checked by Flyspell.") + +;*---------------------------------------------------------------------*/ +;* flyspell-pre-command-hook ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-pre-command-hook () + "Save the current buffer and point for Flyspell's post-command hook." + (interactive) + (setq flyspell-pre-buffer (current-buffer)) + (setq flyspell-pre-point (point)) + (setq flyspell-pre-column (current-column))) + +;*---------------------------------------------------------------------*/ +;* flyspell-mode-off ... */ +;*---------------------------------------------------------------------*/ +;;;###autoload +(defun flyspell-mode-off () + "Turn Flyspell mode off." + ;; we remove the hooks + (remove-hook 'post-command-hook (function flyspell-post-command-hook) t) + (remove-hook 'pre-command-hook (function flyspell-pre-command-hook) t) + (setq after-change-functions (delq 'flyspell-after-change-function + after-change-functions)) + ;; we remove all the flyspell hilightings + (flyspell-delete-all-overlays) + ;; we have to erase pre cache variables + (setq flyspell-pre-buffer nil) + (setq flyspell-pre-point nil) + ;; we mark the mode as killed + (setq flyspell-mode nil)) + +;*---------------------------------------------------------------------*/ +;* flyspell-check-pre-word-p ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-check-pre-word-p () + "Return non-nil if we should check the word before point. +More precisely, it applies to the word that was before point +before the current command." + (cond + ((or (not (numberp flyspell-pre-point)) + (not (bufferp flyspell-pre-buffer)) + (not (buffer-live-p flyspell-pre-buffer))) + nil) + ((and (eq flyspell-pre-pre-point flyspell-pre-point) + (eq flyspell-pre-pre-buffer flyspell-pre-buffer)) + nil) + ((or (and (= flyspell-pre-point (- (point) 1)) + (eq (char-syntax (char-after flyspell-pre-point)) ?w)) + (= flyspell-pre-point (point)) + (= flyspell-pre-point (+ (point) 1))) + nil) + ((and (symbolp this-command) + (not executing-kbd-macro) + (or (get this-command 'flyspell-delayed) + (and (get this-command 'flyspell-deplacement) + (eq flyspell-previous-command this-command))) + (or (= (current-column) 0) + (= (current-column) flyspell-pre-column) + (eq (char-syntax (char-after flyspell-pre-point)) ?w))) + nil) + ((not (eq (current-buffer) flyspell-pre-buffer)) + t) + ((not (and (numberp flyspell-word-cache-start) + (numberp flyspell-word-cache-end))) + t) + (t + (or (< flyspell-pre-point flyspell-word-cache-start) + (> flyspell-pre-point flyspell-word-cache-end))))) + +;*---------------------------------------------------------------------*/ +;* The flyspell after-change-hook, store the change position. In */ +;* the post command hook, we will check, if the word at this */ +;* position has to be spell checked. */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-changes nil) + +;*---------------------------------------------------------------------*/ +;* flyspell-after-change-function ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-after-change-function (start stop len) + "Save the current buffer and point for Flyspell's post-command hook." + (interactive) + (unless (and (symbolp this-command) (get this-command 'flyspell-ignored)) + (setq flyspell-changes (cons (cons start stop) flyspell-changes)))) + +;*---------------------------------------------------------------------*/ +;* flyspell-check-changed-word-p ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-check-changed-word-p (start stop) + "Return t when the changed word has to be checked. +The answer depends of several criteria. +Mostly we check word delimiters." + (cond + ((and (memq (char-after start) '(?\n ? )) (> stop start)) + t) + ((not (numberp flyspell-pre-point)) + t) + ((and (>= flyspell-pre-point start) (<= flyspell-pre-point stop)) + nil) + ((let ((pos (point))) + (or (>= pos start) (<= pos stop) (= pos (1+ stop)))) + nil) + (t + t))) + +;*---------------------------------------------------------------------*/ +;* flyspell-check-word-p ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-check-word-p () + "Return t when the word at `point' has to be checked. +The answer depends of several criteria. +Mostly we check word delimiters." + (cond + ((<= (- (point-max) 1) (point-min)) + ;; the buffer is not filled enough + nil) + ((and (and (> (current-column) 0) + (not (eq (current-column) flyspell-pre-column))) + (save-excursion + (backward-char 1) + (and (looking-at (flyspell-get-not-casechars)) + (or flyspell-consider-dash-as-word-delimiter-flag + (not (looking-at "\\-")))))) + ;; yes because we have reached or typed a word delimiter. + t) + ((symbolp this-command) + (cond + ((get this-command 'flyspell-deplacement) + (not (eq flyspell-previous-command this-command))) + ((get this-command 'flyspell-delayed) + ;; the current command is not delayed, that + ;; is that we must check the word now + (if (or (fboundp 'about-xemacs) (featurep 'xemacs)) + (sit-for flyspell-delay nil) + (sit-for flyspell-delay 0 nil))) + (t t))) + (t t))) + +;*---------------------------------------------------------------------*/ +;* flyspell-debug-signal-no-check ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-debug-signal-no-check (msg obj) + (setq debug-on-error t) + (save-excursion + (let ((buffer (get-buffer-create "*flyspell-debug*"))) + (set-buffer buffer) + (erase-buffer) + (insert "NO-CHECK:\n") + (insert (format " %S : %S\n" msg obj))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-debug-signal-pre-word-checked ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-debug-signal-pre-word-checked () + (setq debug-on-error t) + (save-excursion + (let ((buffer (get-buffer-create "*flyspell-debug*"))) + (set-buffer buffer) + (insert "PRE-WORD:\n") + (insert (format " pre-point : %S\n" flyspell-pre-point)) + (insert (format " pre-buffer : %S\n" flyspell-pre-buffer)) + (insert (format " cache-start: %S\n" flyspell-word-cache-start)) + (insert (format " cache-end : %S\n" flyspell-word-cache-end)) + (goto-char (point-max))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-debug-signal-word-checked ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-debug-signal-word-checked () + (setq debug-on-error t) + (save-excursion + (let ((oldbuf (current-buffer)) + (buffer (get-buffer-create "*flyspell-debug*")) + (point (point))) + (set-buffer buffer) + (insert "WORD:\n") + (insert (format " this-cmd : %S\n" this-command)) + (insert (format " delayed : %S\n" (and (symbolp this-command) + (get this-command 'flyspell-delayed)))) + (insert (format " ignored : %S\n" (and (symbolp this-command) + (get this-command 'flyspell-ignored)))) + (insert (format " point : %S\n" point)) + (insert (format " prev-char : [%c] %S\n" + (progn + (set-buffer oldbuf) + (let ((c (if (> (point) (point-min)) + (save-excursion + (backward-char 1) + (char-after (point))) + ? ))) + (set-buffer buffer) + c)) + (progn + (set-buffer oldbuf) + (let ((c (if (> (point) (point-min)) + (save-excursion + (backward-char 1) + (and (and (looking-at (flyspell-get-not-casechars)) 1) + (and (or flyspell-consider-dash-as-word-delimiter-flag + (not (looking-at "\\-"))) 2)))))) + (set-buffer buffer) + c)))) + (insert (format " because : %S\n" + (cond + ((not (and (symbolp this-command) + (get this-command 'flyspell-delayed))) + ;; the current command is not delayed, that + ;; is that we must check the word now + 'not-delayed) + ((progn + (set-buffer oldbuf) + (let ((c (if (> (point) (point-min)) + (save-excursion + (backward-char 1) + (and (looking-at (flyspell-get-not-casechars)) + (or flyspell-consider-dash-as-word-delimiter-flag + (not (looking-at "\\-")))))))) + (set-buffer buffer) + c)) + ;; yes because we have reached or typed a word delimiter. + 'separator) + ((not (integerp flyspell-delay)) + ;; yes because the user had set up a no-delay configuration. + 'no-delay) + (t + 'sit-for)))) + (goto-char (point-max))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-debug-signal-changed-checked ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-debug-signal-changed-checked () + (setq debug-on-error t) + (save-excursion + (let ((buffer (get-buffer-create "*flyspell-debug*")) + (point (point))) + (set-buffer buffer) + (insert "CHANGED WORD:\n") + (insert (format " point : %S\n" point)) + (goto-char (point-max))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-post-command-hook ... */ +;* ------------------------------------------------------------- */ +;* It is possible that we check several words: */ +;* 1- the current word is checked if the predicate */ +;* FLYSPELL-CHECK-WORD-P is true */ +;* 2- the word that used to be the current word before the */ +;* THIS-COMMAND is checked if: */ +;* a- the previous word is different from the current word */ +;* b- the previous word as not just been checked by the */ +;* previous FLYSPELL-POST-COMMAND-HOOK */ +;* 3- the words changed by the THIS-COMMAND that are neither the */ +;* previous word nor the current word */ +;*---------------------------------------------------------------------*/ +(defun flyspell-post-command-hook () + "The `post-command-hook' used by flyspell to check a word on-the-fly." + (interactive) + (when flyspell-mode + (with-local-quit + (let ((command this-command)) + (if (flyspell-check-pre-word-p) + (save-excursion + '(flyspell-debug-signal-pre-word-checked) + (set-buffer flyspell-pre-buffer) + (save-excursion + (goto-char flyspell-pre-point) + (flyspell-word)))) + (if (flyspell-check-word-p) + (progn + '(flyspell-debug-signal-word-checked) + (flyspell-word) + ;; we remember which word we have just checked. + ;; this will be used next time we will check a word + ;; to compare the next current word with the word + ;; that as been registered in the pre-command-hook + ;; that is these variables are used within the predicate + ;; FLYSPELL-CHECK-PRE-WORD-P + (setq flyspell-pre-pre-buffer (current-buffer)) + (setq flyspell-pre-pre-point (point))) + (progn + (setq flyspell-pre-pre-buffer nil) + (setq flyspell-pre-pre-point nil) + ;; when a word is not checked because of a delayed command + ;; we do not disable the ispell cache. + (if (and (symbolp this-command) (get this-command 'flyspell-delayed)) + (progn + (setq flyspell-word-cache-end -1) + (setq flyspell-word-cache-result '_))))) + (while (consp flyspell-changes) + (let ((start (car (car flyspell-changes))) + (stop (cdr (car flyspell-changes)))) + (if (flyspell-check-changed-word-p start stop) + (save-excursion + '(flyspell-debug-signal-changed-checked) + (goto-char start) + (flyspell-word))) + (setq flyspell-changes (cdr flyspell-changes)))) + (setq flyspell-previous-command command))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-notify-misspell ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-notify-misspell (start end word poss) + (let ((replacements (if (stringp poss) + poss + (if flyspell-sort-corrections + (sort (car (cdr (cdr poss))) 'string<) + (car (cdr (cdr poss))))))) + (if flyspell-issue-message-flag + (message (format "mispelling `%s' %S" word replacements))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-word-search-backward ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-word-search-backward (word bound) + (save-excursion + (let ((r '()) + p) + (while (and (not r) (setq p (search-backward word bound t))) + (let ((lw (flyspell-get-word '()))) + (if (and (consp lw) (string-equal (car lw) word)) + (setq r p) + (goto-char p)))) + r))) + +;*---------------------------------------------------------------------*/ +;* flyspell-word-search-forward ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-word-search-forward (word bound) + (save-excursion + (let ((r '()) + p) + (while (and (not r) (setq p (search-forward word bound t))) + (let ((lw (flyspell-get-word '()))) + (if (and (consp lw) (string-equal (car lw) word)) + (setq r p) + (goto-char (1+ p))))) + r))) + +;*---------------------------------------------------------------------*/ +;* flyspell-word ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-word (&optional following) + "Spell check a word." + (interactive (list current-prefix-arg)) + (if (interactive-p) + (setq following ispell-following-word)) + (save-excursion + ;; use the correct dictionary + (flyspell-accept-buffer-local-defs) + (let* ((cursor-location (point)) + (flyspell-word (flyspell-get-word following)) + start end poss word) + (if (or (eq flyspell-word nil) + (and (fboundp flyspell-generic-check-word-p) + (not (funcall flyspell-generic-check-word-p)))) + t + (progn + ;; destructure return flyspell-word info list. + (setq start (car (cdr flyspell-word)) + end (car (cdr (cdr flyspell-word))) + word (car flyspell-word)) + ;; before checking in the directory, we check for doublons. + (cond + ((and (or (not (eq ispell-parser 'tex)) + (and (> start (point-min)) + (not (eq (char-after (1- start)) ?})) + (not (eq (char-after (1- start)) ?\\)))) + flyspell-mark-duplications-flag + (save-excursion + (goto-char (1- start)) + (let ((p (flyspell-word-search-backward + word + (- start (1+ (- end start)))))) + (and p (/= p (1- start)))))) + ;; yes, this is a doublon + (flyspell-highlight-incorrect-region start end 'doublon) + nil) + ((and (eq flyspell-word-cache-start start) + (eq flyspell-word-cache-end end) + (string-equal flyspell-word-cache-word word)) + ;; this word had been already checked, we skip + flyspell-word-cache-result) + ((and (eq ispell-parser 'tex) + (flyspell-tex-command-p flyspell-word)) + ;; this is a correct word (because a tex command) + (flyspell-unhighlight-at start) + (if (> end start) + (flyspell-unhighlight-at (- end 1))) + t) + (t + ;; we setup the cache + (setq flyspell-word-cache-start start) + (setq flyspell-word-cache-end end) + (setq flyspell-word-cache-word word) + ;; now check spelling of word. + (process-send-string ispell-process "%\n") + ;; put in verbose mode + (process-send-string ispell-process + (concat "^" word "\n")) + ;; we mark the ispell process so it can be killed + ;; when emacs is exited without query + (if (fboundp 'process-kill-without-query) + (process-kill-without-query ispell-process)) + ;; wait until ispell has processed word + (while (progn + (accept-process-output ispell-process) + (not (string= "" (car ispell-filter))))) + ;; (process-send-string ispell-process "!\n") + ;; back to terse mode. + (setq ispell-filter (cdr ispell-filter)) + (if (consp ispell-filter) + (setq poss (ispell-parse-output (car ispell-filter)))) + (let ((res (cond ((eq poss t) + ;; correct + (setq flyspell-word-cache-result t) + (flyspell-unhighlight-at start) + (if (> end start) + (flyspell-unhighlight-at (- end 1))) + t) + ((and (stringp poss) flyspell-highlight-flag) + ;; correct + (setq flyspell-word-cache-result t) + (flyspell-unhighlight-at start) + (if (> end start) + (flyspell-unhighlight-at (- end 1))) + t) + ((null poss) + (setq flyspell-word-cache-result t) + (flyspell-unhighlight-at start) + (if (> end start) + (flyspell-unhighlight-at (- end 1))) + t) + ((or (and (< flyspell-duplicate-distance 0) + (or (save-excursion + (goto-char start) + (flyspell-word-search-backward + word + (point-min))) + (save-excursion + (goto-char end) + (flyspell-word-search-forward + word + (point-max))))) + (and (> flyspell-duplicate-distance 0) + (or (save-excursion + (goto-char start) + (flyspell-word-search-backward + word + (- start + flyspell-duplicate-distance))) + (save-excursion + (goto-char end) + (flyspell-word-search-forward + word + (+ end + flyspell-duplicate-distance)))))) + (setq flyspell-word-cache-result nil) + (if flyspell-highlight-flag + (flyspell-highlight-duplicate-region + start end) + (message (format "duplicate `%s'" word))) + nil) + (t + (setq flyspell-word-cache-result nil) + ;; incorrect highlight the location + (if flyspell-highlight-flag + (flyspell-highlight-incorrect-region + start end poss) + (flyspell-notify-misspell start end word poss)) + nil)))) + ;; return to original location + (goto-char cursor-location) + (if ispell-quit (setq ispell-quit nil)) + res)))))))) + +;* {*---------------------------------------------------------------------*} */ +;* {* flyspell-tex-math-initialized ... *} */ +;* {*---------------------------------------------------------------------*} */ +;* (defvar flyspell-tex-math-initialized nil) */ +;* */ +;* {*---------------------------------------------------------------------*} */ +;* {* flyspell-math-tex-command-p ... *} */ +;* {* ------------------------------------------------------------- *} */ +;* {* This function uses the texmathp package to check if (point) *} */ +;* {* is within a tex command. In order to avoid using *} */ +;* {* condition-case each time we use the variable *} */ +;* {* flyspell-tex-math-initialized to make a special case the first *} */ +;* {* time that function is called. *} */ +;* {*---------------------------------------------------------------------*} */ +;* (defun flyspell-math-tex-command-p () */ +;* (cond */ +;* (flyspell-check-tex-math-command */ +;* nil) */ +;* ((eq flyspell-tex-math-initialized t) */ +;* (texmathp)) */ +;* ((eq flyspell-tex-math-initialized 'error) */ +;* nil) */ +;* (t */ +;* (setq flyspell-tex-math-initialized t) */ +;* (condition-case nil */ +;* (texmathp) */ +;* (error (progn */ +;* (setq flyspell-tex-math-initialized 'error) */ +;* nil)))))) */ + +;*---------------------------------------------------------------------*/ +;* flyspell-math-tex-command-p ... */ +;* ------------------------------------------------------------- */ +;* This function uses the texmathp package to check if point */ +;* is within a TeX math environment. `texmathp' can yield errors */ +;* if the document is currently not valid TeX syntax. */ +;*---------------------------------------------------------------------*/ +(defun flyspell-math-tex-command-p () + (when (fboundp 'texmathp) + (if flyspell-check-tex-math-command + nil + (condition-case nil + (texmathp) + (error nil))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-tex-command-p ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-tex-command-p (word) + "Return t if WORD is a TeX command." + (or (save-excursion + (let ((b (car (cdr word)))) + (and (re-search-backward "\\\\" (- (point) 100) t) + (or (= (match-end 0) b) + (and (goto-char (match-end 0)) + (looking-at flyspell-tex-command-regexp) + (>= (match-end 0) b)))))) + (flyspell-math-tex-command-p))) + +;*---------------------------------------------------------------------*/ +;* flyspell-casechars-cache ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-casechars-cache nil) +(defvar flyspell-ispell-casechars-cache nil) +(make-variable-buffer-local 'flyspell-casechars-cache) +(make-variable-buffer-local 'flyspell-ispell-casechars-cache) + +;*---------------------------------------------------------------------*/ +;* flyspell-get-casechars ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-get-casechars () + "This function builds a string that is the regexp of word chars. +In order to avoid one useless string construction, +this function changes the last char of the `ispell-casechars' string." + (let ((ispell-casechars (ispell-get-casechars))) + (cond + ((eq ispell-parser 'tex) + (setq flyspell-ispell-casechars-cache ispell-casechars) + (setq flyspell-casechars-cache + (concat (substring ispell-casechars + 0 + (- (length ispell-casechars) 1)) + "]")) + flyspell-casechars-cache) + (t + (setq flyspell-ispell-casechars-cache ispell-casechars) + (setq flyspell-casechars-cache ispell-casechars) + flyspell-casechars-cache)))) + +;*---------------------------------------------------------------------*/ +;* flyspell-get-not-casechars-cache ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-not-casechars-cache nil) +(defvar flyspell-ispell-not-casechars-cache nil) +(make-variable-buffer-local 'flyspell-not-casechars-cache) +(make-variable-buffer-local 'flyspell-ispell-not-casechars-cache) + +;*---------------------------------------------------------------------*/ +;* flyspell-get-not-casechars ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-get-not-casechars () + "This function builds a string that is the regexp of non-word chars." + (let ((ispell-not-casechars (ispell-get-not-casechars))) + (cond + ((eq ispell-parser 'tex) + (setq flyspell-ispell-not-casechars-cache ispell-not-casechars) + (setq flyspell-not-casechars-cache + (concat (substring ispell-not-casechars + 0 + (- (length ispell-not-casechars) 1)) + "]")) + flyspell-not-casechars-cache) + (t + (setq flyspell-ispell-not-casechars-cache ispell-not-casechars) + (setq flyspell-not-casechars-cache ispell-not-casechars) + flyspell-not-casechars-cache)))) + +;*---------------------------------------------------------------------*/ +;* flyspell-get-word ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-get-word (following &optional extra-otherchars) + "Return the word for spell-checking according to Ispell syntax. +If optional argument FOLLOWING is non-nil or if `flyspell-following-word' +is non-nil when called interactively, then the following word +\(rather than preceding\) is checked when the cursor is not over a word. +Optional second argument contains otherchars that can be included in word +many times. + +Word syntax described by `flyspell-dictionary-alist' (which see)." + (let* ((flyspell-casechars (flyspell-get-casechars)) + (flyspell-not-casechars (flyspell-get-not-casechars)) + (ispell-otherchars (ispell-get-otherchars)) + (ispell-many-otherchars-p (ispell-get-many-otherchars-p)) + (word-regexp (concat flyspell-casechars + "+\\(" + (if (not (string= "" ispell-otherchars)) + (concat ispell-otherchars "?")) + (if extra-otherchars + (concat extra-otherchars "?")) + flyspell-casechars + "+\\)" + (if (or ispell-many-otherchars-p + extra-otherchars) + "*" "?"))) + did-it-once prevpt + start end word) + ;; find the word + (if (not (looking-at flyspell-casechars)) + (if following + (re-search-forward flyspell-casechars (point-max) t) + (re-search-backward flyspell-casechars (point-min) t))) + ;; move to front of word + (re-search-backward flyspell-not-casechars (point-min) 'start) + (while (and (or (and (not (string= "" ispell-otherchars)) + (looking-at ispell-otherchars)) + (and extra-otherchars (looking-at extra-otherchars))) + (not (bobp)) + (or (not did-it-once) + ispell-many-otherchars-p) + (not (eq prevpt (point)))) + (if (and extra-otherchars (looking-at extra-otherchars)) + (progn + (backward-char 1) + (if (looking-at flyspell-casechars) + (re-search-backward flyspell-not-casechars (point-min) 'move))) + (setq did-it-once t + prevpt (point)) + (backward-char 1) + (if (looking-at flyspell-casechars) + (re-search-backward flyspell-not-casechars (point-min) 'move) + (backward-char -1)))) + ;; Now mark the word and save to string. + (if (not (re-search-forward word-regexp (point-max) t)) + nil + (progn + (setq start (match-beginning 0) + end (point) + word (buffer-substring-no-properties start end)) + (list word start end))))) + +(defun flyspell-get-word.old (following) + "Return the word for spell-checking according to Ispell syntax. +If argument FOLLOWING is non-nil or if `ispell-following-word' +is non-nil when called interactively, then the following word +\(rather than preceding\) is checked when the cursor is not over a word. +Optional second argument contains other chars that can be included in word +many times. + +Word syntax described by `ispell-dictionary-alist' (which see)." + (let* ((flyspell-casechars (flyspell-get-casechars)) + (flyspell-not-casechars (flyspell-get-not-casechars)) + (ispell-otherchars (ispell-get-otherchars)) + (ispell-many-otherchars-p (ispell-get-many-otherchars-p)) + (word-regexp (if (string< "" ispell-otherchars) + (concat flyspell-casechars + "+\\(" + ispell-otherchars + (if (> (length ispell-otherchars) 0) "?") + flyspell-casechars + "+\\)" + (if ispell-many-otherchars-p + "*" "?")) + (concat flyspell-casechars "+"))) + did-it-once + start end word) + ;; find the word + (if (not (looking-at flyspell-casechars)) + (if following + (re-search-forward flyspell-casechars (point-max) t) + (re-search-backward flyspell-casechars (point-min) t))) + ;; move to front of word + (re-search-backward flyspell-not-casechars (point-min) 'start) + (let ((pos nil)) + (if (string< "" ispell-otherchars) + (while (and (looking-at ispell-otherchars) + (not (bobp)) + (or (not did-it-once) + ispell-many-otherchars-p) + (not (eq pos (point)))) + (setq pos (point)) + (setq did-it-once t) + (backward-char 1) + (if (looking-at flyspell-casechars) + (re-search-backward flyspell-not-casechars (point-min) 'move) + (backward-char -1))))) + ;; Now mark the word and save to string. + (if (eq (re-search-forward word-regexp (point-max) t) nil) + nil + (progn + (setq start (match-beginning 0) + end (point) + word (buffer-substring-no-properties start end)) + (list word start end))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-small-region ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-small-region (beg end) + "Flyspell text between BEG and END." + (save-excursion + (if (> beg end) + (let ((old beg)) + (setq beg end) + (setq end old))) + (goto-char beg) + (let ((count 0)) + (while (< (point) end) + (if (and flyspell-issue-message-flag (= count 100)) + (progn + (message "Spell Checking...%d%%" + (* 100 (/ (float (- (point) beg)) (- end beg)))) + (setq count 0)) + (setq count (+ 1 count))) + (flyspell-word) + (sit-for 0) + (let ((cur (point))) + (forward-word 1) + (if (and (< (point) end) (> (point) (+ cur 1))) + (backward-char 1))))) + (backward-char 1) + (if flyspell-issue-message-flag (message "Spell Checking completed.")) + (flyspell-word))) + +;*---------------------------------------------------------------------*/ +;* flyspell-external-ispell-process ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-external-ispell-process '() + "The external Flyspell Ispell process.") + +;*---------------------------------------------------------------------*/ +;* flyspell-external-ispell-buffer ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-external-ispell-buffer '()) +(defvar flyspell-large-region-buffer '()) +(defvar flyspell-large-region-beg (point-min)) +(defvar flyspell-large-region-end (point-max)) + +;*---------------------------------------------------------------------*/ +;* flyspell-external-point-words ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-external-point-words () + (let ((buffer flyspell-external-ispell-buffer)) + (set-buffer buffer) + (beginning-of-buffer) + (let ((size (- flyspell-large-region-end flyspell-large-region-beg)) + (start flyspell-large-region-beg) + (pword "") + (pcount 1)) + ;; now we are done with ispell, we have to find the word in + ;; the initial buffer + (while (< (point) (- (point-max) 1)) + ;; we have to fetch the incorrect word + (if (re-search-forward "\\([^\n]+\\)\n" (point-max) t) + (let ((word (match-string 1))) + (if (string= word pword) + (setq pcount (1+ pcount)) + (progn + (setq pword word) + (setq pcount 1))) + (goto-char (match-end 0)) + (if flyspell-issue-message-flag + (message "Spell Checking...%d%% [%s]" + (* 100 (/ (float (point)) (point-max))) + word)) + (set-buffer flyspell-large-region-buffer) + (goto-char flyspell-large-region-beg) + (let ((keep t) + (n 0)) + (while (and (or (< n pcount) keep) + (search-forward word flyspell-large-region-end t)) + (progn + (goto-char (- (point) 1)) + (setq n (1+ n)) + (setq keep (flyspell-word)))) + (if (= n pcount) + (setq flyspell-large-region-beg (point)))) + (set-buffer buffer)) + (goto-char (point-max))))) + ;; we are done + (if flyspell-issue-message-flag (message "Spell Checking completed.")) + ;; ok, we are done with pointing out incorrect words, we just + ;; have to kill the temporary buffer + (kill-buffer flyspell-external-ispell-buffer) + (setq flyspell-external-ispell-buffer nil))) + +;*---------------------------------------------------------------------*/ +;* flyspell-process-localwords ... */ +;* ------------------------------------------------------------- */ +;* This function is used to prevent checking words declared */ +;* explictitly correct on large regions. */ +;*---------------------------------------------------------------------*/ +(defun flyspell-process-localwords () + "Parse Localwords in the buffer and remove them from the mispellings +buffer before flyspell attempts to check them." + (let (localwords + (current-buffer curbuf) + (mispellings-buffer buffer) + (ispell-casechars (ispell-get-casechars))) + ;; Get localwords from the original buffer + (save-excursion + (set-buffer current-buffer) +;* (flyspell-delete-all-overlays) */ + (beginning-of-buffer) + ;; Localwords parsing stolen form ispell.el + (while (search-forward ispell-words-keyword nil t) + (let ((end (save-excursion (end-of-line) (point))) + string) + ;; buffer-local words separated by a space, and can contain + ;; any character other than a space. Not rigorous enough. + (while (re-search-forward " *\\([^ ]+\\)" end t) + (setq string (buffer-substring-no-properties (match-beginning 1) + (match-end 1))) + ;; This can fail when string contains a word with illegal chars. + ;; Error handling needs to be added between ispell and emacs. + (if (and (< 1 (length string)) + (equal 0 (string-match ispell-casechars string))) + (setq localwords (add-to-list 'localwords string))))))) + ;; Remove localwords matches + (set-buffer mispellings-buffer) + (while localwords + (beginning-of-buffer) + (delete-matching-lines (concat "^" (car localwords) "$")) + (setq localwords (cdr localwords))) + (end-of-buffer))) + +;*---------------------------------------------------------------------*/ +;* flyspell-large-region ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-large-region (beg end) + (let* ((curbuf (current-buffer)) + (buffer (get-buffer-create "*flyspell-region*"))) + (setq flyspell-external-ispell-buffer buffer) + (setq flyspell-large-region-buffer curbuf) + (setq flyspell-large-region-beg beg) + (setq flyspell-large-region-end end) + (set-buffer buffer) + (erase-buffer) + ;; this is done, we can start checking... + (if flyspell-issue-message-flag (message "Checking region...")) + (set-buffer curbuf) + (let ((c (apply 'call-process-region beg + end + ispell-program-name + nil + buffer + nil + (if (boundp 'ispell-list-command) + ispell-list-command + flyspell-list-command) + (let (args) + ;; Local dictionary becomes the global dictionary in use. + (if ispell-local-dictionary + (setq ispell-dictionary ispell-local-dictionary)) + (setq args (ispell-get-ispell-args)) + (if ispell-dictionary ; use specified dictionary + (setq args + (append (list "-d" ispell-dictionary) args))) + (if ispell-personal-dictionary ; use specified pers dict + (setq args + (append args + (list "-p" + (expand-file-name + ispell-personal-dictionary))))) + (setq args (append args ispell-extra-args)) + args)))) + (if (= c 0) + (progn + (flyspell-process-localwords) + (with-current-buffer curbuf + (flyspell-delete-region-overlays beg end)) + (flyspell-external-point-words)) + (error "Can't check region..."))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-region ... */ +;* ------------------------------------------------------------- */ +;* Because `ispell -a' is too slow, it is not possible to use */ +;* it on large region. Then, when ispell is invoked on a large */ +;* text region, a new `ispell -l' process is spawned. The */ +;* pointed out words are then searched in the region a checked with */ +;* regular flyspell means. */ +;*---------------------------------------------------------------------*/ +;;;###autoload +(defun flyspell-region (beg end) + "Flyspell text between BEG and END." + (interactive "r") + (if (= beg end) + () + (save-excursion + (if (> beg end) + (let ((old beg)) + (setq beg end) + (setq end old))) + (if (and flyspell-large-region (> (- end beg) flyspell-large-region)) + (flyspell-large-region beg end) + (flyspell-small-region beg end))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-buffer ... */ +;*---------------------------------------------------------------------*/ +;;;###autoload +(defun flyspell-buffer () + "Flyspell whole buffer." + (interactive) + (flyspell-region (point-min) (point-max))) + +;*---------------------------------------------------------------------*/ +;* old next error position ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-old-buffer-error nil) +(defvar flyspell-old-pos-error nil) + +;*---------------------------------------------------------------------*/ +;* flyspell-goto-next-error ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-goto-next-error () + "Go to the next previously detected error. +In general FLYSPELL-GOTO-NEXT-ERROR must be used after +FLYSPELL-BUFFER." + (interactive) + (let ((pos (point)) + (max (point-max))) + (if (and (eq (current-buffer) flyspell-old-buffer-error) + (eq pos flyspell-old-pos-error)) + (progn + (if (= flyspell-old-pos-error max) + ;; goto beginning of buffer + (progn + (message "Restarting from beginning of buffer") + (goto-char (point-min))) + (forward-word 1)) + (setq pos (point)))) + ;; seek the next error + (while (and (< pos max) + (let ((ovs (overlays-at pos)) + (r '())) + (while (and (not r) (consp ovs)) + (if (flyspell-overlay-p (car ovs)) + (setq r t) + (setq ovs (cdr ovs)))) + (not r))) + (setq pos (1+ pos))) + ;; save the current location for next invocation + (setq flyspell-old-pos-error pos) + (setq flyspell-old-buffer-error (current-buffer)) + (goto-char pos) + (if (= pos max) + (message "No more miss-spelled word!")))) + +;*---------------------------------------------------------------------*/ +;* flyspell-overlay-p ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-overlay-p (o) + "A predicate that return true iff O is an overlay used by flyspell." + (and (overlayp o) (overlay-get o 'flyspell-overlay))) + +;*---------------------------------------------------------------------*/ +;* flyspell-delete-region-overlays ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-delete-region-overlays (beg end) + "Delete overlays used by flyspell in a given region." + (let ((l (overlays-in beg end))) + (while (consp l) + (progn + (if (flyspell-overlay-p (car l)) + (delete-overlay (car l))) + (setq l (cdr l)))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-delete-all-overlays ... */ +;* ------------------------------------------------------------- */ +;* Remove all the overlays introduced by flyspell. */ +;*---------------------------------------------------------------------*/ +(defun flyspell-delete-all-overlays () + "Delete all the overlays used by flyspell." + (flyspell-delete-region-overlays (point-min) (point-max))) + +;*---------------------------------------------------------------------*/ +;* flyspell-unhighlight-at ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-unhighlight-at (pos) + "Remove the flyspell overlay that are located at POS." + (if flyspell-persistent-highlight + (let ((overlays (overlays-at pos))) + (while (consp overlays) + (if (flyspell-overlay-p (car overlays)) + (delete-overlay (car overlays))) + (setq overlays (cdr overlays)))) + (if (flyspell-overlay-p flyspell-overlay) + (delete-overlay flyspell-overlay)))) + +;*---------------------------------------------------------------------*/ +;* flyspell-properties-at-p ... */ +;* ------------------------------------------------------------- */ +;* Is there an highlight properties at position pos? */ +;*---------------------------------------------------------------------*/ +(defun flyspell-properties-at-p (pos) + "Return t if there is a text property at POS, not counting `local-map'. +If variable `flyspell-highlight-properties' is set to nil, +text with properties are not checked. This function is used to discover +if the character at POS has any other property." + (let ((prop (text-properties-at pos)) + (keep t)) + (while (and keep (consp prop)) + (if (and (eq (car prop) 'local-map) (consp (cdr prop))) + (setq prop (cdr (cdr prop))) + (setq keep nil))) + (consp prop))) + +;*---------------------------------------------------------------------*/ +;* make-flyspell-overlay ... */ +;*---------------------------------------------------------------------*/ +(defun make-flyspell-overlay (beg end face mouse-face) + "Allocate an overlay to highlight an incorrect word. +BEG and END specify the range in the buffer of that word. +FACE and MOUSE-FACE specify the `face' and `mouse-face' properties +for the overlay." + (let ((flyspell-overlay (make-overlay beg end nil t nil))) + (overlay-put flyspell-overlay 'face face) + (overlay-put flyspell-overlay 'mouse-face mouse-face) + (overlay-put flyspell-overlay 'flyspell-overlay t) + (overlay-put flyspell-overlay 'evaporate t) + (overlay-put flyspell-overlay 'help-echo "mouse-2: correct word at point") + (if flyspell-use-local-map + (overlay-put flyspell-overlay + flyspell-overlay-keymap-property-name + flyspell-mouse-map)) + (when (eq face 'flyspell-incorrect-face) + (and (stringp flyspell-before-incorrect-word-string) + (overlay-put flyspell-overlay 'before-string + flyspell-before-incorrect-word-string)) + (and (stringp flyspell-after-incorrect-word-string) + (overlay-put flyspell-overlay 'after-string + flyspell-after-incorrect-word-string))) + flyspell-overlay)) + +;*---------------------------------------------------------------------*/ +;* flyspell-highlight-incorrect-region ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-highlight-incorrect-region (beg end poss) + "Set up an overlay on a misspelled word, in the buffer from BEG to END." + (unless (run-hook-with-args-until-success + 'flyspell-incorrect-hook beg end poss) + (if (or flyspell-highlight-properties (not (flyspell-properties-at-p beg))) + (progn + ;; we cleanup all the overlay that are in the region, not + ;; beginning at the word start position + (if (< (1+ beg) end) + (let ((os (overlays-in (1+ beg) end))) + (while (consp os) + (if (flyspell-overlay-p (car os)) + (delete-overlay (car os))) + (setq os (cdr os))))) + ;; we cleanup current overlay at the same position + (if (and (not flyspell-persistent-highlight) + (overlayp flyspell-overlay)) + (delete-overlay flyspell-overlay) + (let ((os (overlays-at beg))) + (while (consp os) + (if (flyspell-overlay-p (car os)) + (delete-overlay (car os))) + (setq os (cdr os))))) + ;; now we can use a new overlay + (setq flyspell-overlay + (make-flyspell-overlay beg end + 'flyspell-incorrect-face + 'highlight)))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-highlight-duplicate-region ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-highlight-duplicate-region (beg end) + "Set up an overlay on a duplicated word, in the buffer from BEG to END." + (if (or flyspell-highlight-properties (not (flyspell-properties-at-p beg))) + (progn + ;; we cleanup current overlay at the same position + (if (and (not flyspell-persistent-highlight) + (overlayp flyspell-overlay)) + (delete-overlay flyspell-overlay) + (let ((overlays (overlays-at beg))) + (while (consp overlays) + (if (flyspell-overlay-p (car overlays)) + (delete-overlay (car overlays))) + (setq overlays (cdr overlays))))) + ;; now we can use a new overlay + (setq flyspell-overlay + (make-flyspell-overlay beg end + 'flyspell-duplicate-face + 'highlight))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-auto-correct-cache ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-auto-correct-pos nil) +(defvar flyspell-auto-correct-region nil) +(defvar flyspell-auto-correct-ring nil) +(defvar flyspell-auto-correct-word nil) +(make-variable-buffer-local 'flyspell-auto-correct-pos) +(make-variable-buffer-local 'flyspell-auto-correct-region) +(make-variable-buffer-local 'flyspell-auto-correct-ring) +(make-variable-buffer-local 'flyspell-auto-correct-word) + +;*---------------------------------------------------------------------*/ +;* flyspell-check-previous-highlighted-word ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-check-previous-highlighted-word (&optional arg) + "Correct the closer misspelled word. +This function scans a mis-spelled word before the cursor. If it finds one +it proposes replacement for that word. With prefix arg, count that many +misspelled words backwards." + (interactive) + (let ((pos1 (point)) + (pos (point)) + (arg (if (or (not (numberp arg)) (< arg 1)) 1 arg)) + ov ovs) + (if (catch 'exit + (while (and (setq pos (previous-overlay-change pos)) + (not (= pos pos1))) + (setq pos1 pos) + (if (> pos (point-min)) + (progn + (setq ovs (overlays-at (1- pos))) + (while (consp ovs) + (setq ov (car ovs)) + (setq ovs (cdr ovs)) + (if (and (overlay-get ov 'flyspell-overlay) + (= 0 (setq arg (1- arg)))) + (throw 'exit t))))))) + (save-excursion + (goto-char pos) + (ispell-word)) + (error "No word to correct before point")))) + +;*---------------------------------------------------------------------*/ +;* flyspell-display-next-corrections ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-display-next-corrections (corrections) + (let ((string "Corrections:") + (l corrections) + (pos '())) + (while (< (length string) 80) + (if (equal (car l) flyspell-auto-correct-word) + (setq pos (cons (+ 1 (length string)) pos))) + (setq string (concat string " " (car l))) + (setq l (cdr l))) + (while (consp pos) + (let ((num (car pos))) + (put-text-property num + (+ num (length flyspell-auto-correct-word)) + 'face + 'flyspell-incorrect-face + string)) + (setq pos (cdr pos))) + (if (fboundp 'display-message) + (display-message 'no-log string) + (message string)))) + +;*---------------------------------------------------------------------*/ +;* flyspell-abbrev-table ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-abbrev-table () + (if flyspell-use-global-abbrev-table-p + global-abbrev-table + local-abbrev-table)) + +;*---------------------------------------------------------------------*/ +;* flyspell-define-abbrev ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-define-abbrev (name expansion) + (let ((table (flyspell-abbrev-table))) + (when table + (define-abbrev table name expansion)))) + +;*---------------------------------------------------------------------*/ +;* flyspell-auto-correct-word ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-auto-correct-word () + "Correct the current word. +This command proposes various successive corrections for the current word." + (interactive) + (let ((pos (point)) + (old-max (point-max))) + ;; use the correct dictionary + (flyspell-accept-buffer-local-defs) + (if (and (eq flyspell-auto-correct-pos pos) + (consp flyspell-auto-correct-region)) + ;; we have already been using the function at the same location + (let* ((start (car flyspell-auto-correct-region)) + (len (cdr flyspell-auto-correct-region))) + (flyspell-unhighlight-at start) + (delete-region start (+ start len)) + (setq flyspell-auto-correct-ring (cdr flyspell-auto-correct-ring)) + (let* ((word (car flyspell-auto-correct-ring)) + (len (length word))) + (rplacd flyspell-auto-correct-region len) + (goto-char start) + (if flyspell-abbrev-p + (if (flyspell-already-abbrevp (flyspell-abbrev-table) + flyspell-auto-correct-word) + (flyspell-change-abbrev (flyspell-abbrev-table) + flyspell-auto-correct-word + word) + (flyspell-define-abbrev flyspell-auto-correct-word word))) + (funcall flyspell-insert-function word) + (flyspell-word) + (flyspell-display-next-corrections flyspell-auto-correct-ring)) + (flyspell-ajust-cursor-point pos (point) old-max) + (setq flyspell-auto-correct-pos (point))) + ;; fetch the word to be checked + (let ((word (flyspell-get-word nil))) + (setq flyspell-auto-correct-region nil) + (if (consp word) + (let ((start (car (cdr word))) + (end (car (cdr (cdr word)))) + (word (car word)) + poss) + (setq flyspell-auto-correct-word word) + ;; now check spelling of word. + (process-send-string ispell-process "%\n") ;put in verbose mode + (process-send-string ispell-process (concat "^" word "\n")) + ;; wait until ispell has processed word + (while (progn + (accept-process-output ispell-process) + (not (string= "" (car ispell-filter))))) + (setq ispell-filter (cdr ispell-filter)) + (if (consp ispell-filter) + (setq poss (ispell-parse-output (car ispell-filter)))) + (cond + ((or (eq poss t) (stringp poss)) + ;; don't correct word + t) + ((null poss) + ;; ispell error + (error "Ispell: error in Ispell process")) + (t + ;; the word is incorrect, we have to propose a replacement + (let ((replacements (if flyspell-sort-corrections + (sort (car (cdr (cdr poss))) 'string<) + (car (cdr (cdr poss)))))) + (if (consp replacements) + (progn + (let ((replace (car replacements))) + (let ((new-word replace)) + (if (not (equal new-word (car poss))) + (progn + ;; the save the current replacements + (setq flyspell-auto-correct-region + (cons start (length new-word))) + (let ((l replacements)) + (while (consp (cdr l)) + (setq l (cdr l))) + (rplacd l (cons (car poss) replacements))) + (setq flyspell-auto-correct-ring + replacements) + (flyspell-unhighlight-at start) + (delete-region start end) + (funcall flyspell-insert-function new-word) + (if flyspell-abbrev-p + (if (flyspell-already-abbrevp + (flyspell-abbrev-table) word) + (flyspell-change-abbrev + (flyspell-abbrev-table) + word + new-word) + (flyspell-define-abbrev word + new-word))) + (flyspell-word) + (flyspell-display-next-corrections + (cons new-word flyspell-auto-correct-ring)) + (flyspell-ajust-cursor-point pos + (point) + old-max)))))))))) + (ispell-pdict-save t))) + (setq flyspell-auto-correct-pos (point)))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-auto-correct-previous-pos ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-auto-correct-previous-pos nil + "Holds the start of the first incorrect word before point.") + +;*---------------------------------------------------------------------*/ +;* flyspell-auto-correct-previous-hook ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-auto-correct-previous-hook () + "Hook to track successive calls to `flyspell-auto-correct-previous-word'. +Sets flyspell-auto-correct-previous-pos to nil" + (interactive) + (remove-hook 'pre-command-hook (function flyspell-auto-correct-previous-hook) t) + (unless (eq this-command (function flyspell-auto-correct-previous-word)) + (setq flyspell-auto-correct-previous-pos nil))) + +;*---------------------------------------------------------------------*/ +;* flyspell-auto-correct-previous-word ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-auto-correct-previous-word (position) + "*Auto correct the first mispelled word that occurs before point." + (interactive "d") + + (add-hook 'pre-command-hook + (function flyspell-auto-correct-previous-hook) t t) + + (save-excursion + (unless flyspell-auto-correct-previous-pos + ;; only reset if a new overlay exists + (setq flyspell-auto-correct-previous-pos nil) + + (let ((overlay-list (overlays-in (point-min) position)) + (new-overlay 'dummy-value)) + + ;; search for previous (new) flyspell overlay + (while (and new-overlay + (or (not (flyspell-overlay-p new-overlay)) + ;; check if its face has changed + (not (eq (get-char-property + (overlay-start new-overlay) 'face) + 'flyspell-incorrect-face)))) + (setq new-overlay (car-safe overlay-list)) + (setq overlay-list (cdr-safe overlay-list))) + + ;; if nothing new exits new-overlay should be nil + (if new-overlay;; the length of the word may change so go to the start + (setq flyspell-auto-correct-previous-pos + (overlay-start new-overlay))))) + + (when flyspell-auto-correct-previous-pos + (save-excursion + (goto-char flyspell-auto-correct-previous-pos) + (let ((ispell-following-word t));; point is at start + (if (numberp flyspell-auto-correct-previous-pos) + (goto-char flyspell-auto-correct-previous-pos)) + (flyspell-auto-correct-word)) + ;; the point may have moved so reset this + (setq flyspell-auto-correct-previous-pos (point)))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-correct-word ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-correct-word (event) + "Pop up a menu of possible corrections for a misspelled word. +The word checked is the word at the mouse position." + (interactive "e") + ;; use the correct dictionary + (flyspell-accept-buffer-local-defs) + ;; retain cursor location (I don't know why but save-excursion here fails). + (let ((save (point))) + (mouse-set-point event) + (let ((cursor-location (point)) + (word (flyspell-get-word nil)) + (case-fold-search nil)) + (if (consp word) + (let ((start (car (cdr word))) + (end (car (cdr (cdr word)))) + (word (car word)) + poss replace) + ;; now check spelling of word. + (process-send-string ispell-process "%\n") ;put in verbose mode + (process-send-string ispell-process (concat "^" word "\n")) + ;; wait until ispell has processed word + (while (progn + (accept-process-output ispell-process) + (not (string= "" (car ispell-filter))))) + (setq ispell-filter (cdr ispell-filter)) + (if (consp ispell-filter) + (setq poss (ispell-parse-output (car ispell-filter)))) + (cond + ((or (eq poss t) (stringp poss)) + ;; don't correct word + t) + ((null poss) + ;; ispell error + (error "Ispell: error in Ispell process")) + ((string-match "GNU" (emacs-version)) + ;; the word is incorrect, we have to propose a replacement + (setq replace (flyspell-emacs-popup event poss word)) + (cond ((eq replace 'ignore) + (goto-char save) + nil) + ((eq replace 'save) + (goto-char save) + (process-send-string ispell-process + (concat "*" word "\n")) + (flyspell-unhighlight-at cursor-location) + (setq ispell-pdict-modified-p '(t))) + ((or (eq replace 'buffer) (eq replace 'session)) + (process-send-string ispell-process + (concat "@" word "\n")) + (if (null ispell-pdict-modified-p) + (setq ispell-pdict-modified-p + (list ispell-pdict-modified-p))) + (flyspell-unhighlight-at cursor-location) + (goto-char save) + (if (eq replace 'buffer) + (ispell-add-per-file-word-list word))) + (replace + (flyspell-unhighlight-at cursor-location) + (let ((new-word (if (atom replace) + replace + (car replace))) + (cursor-location + (+ (- (length word) (- end start)) + cursor-location))) + (if (not (equal new-word (car poss))) + (let ((old-max (point-max))) + (delete-region start end) + (funcall flyspell-insert-function new-word) + (if flyspell-abbrev-p + (flyspell-define-abbrev word new-word)) + (flyspell-ajust-cursor-point save + cursor-location + old-max))))) + (t + (goto-char save) + nil))) + ((eq flyspell-emacs 'xemacs) + (flyspell-xemacs-popup + event poss word cursor-location start end save) + (goto-char save))) + (ispell-pdict-save t)))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-xemacs-correct ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-xemacs-correct (replace poss word cursor-location start end save) + "The xemacs popup menu callback." + (cond ((eq replace 'ignore) + nil) + ((eq replace 'save) + (process-send-string ispell-process (concat "*" word "\n")) + (process-send-string ispell-process "#\n") + (flyspell-unhighlight-at cursor-location) + (setq ispell-pdict-modified-p '(t))) + ((or (eq replace 'buffer) (eq replace 'session)) + (process-send-string ispell-process (concat "@" word "\n")) + (flyspell-unhighlight-at cursor-location) + (if (null ispell-pdict-modified-p) + (setq ispell-pdict-modified-p + (list ispell-pdict-modified-p))) + (if (eq replace 'buffer) + (ispell-add-per-file-word-list word))) + (replace + (let ((old-max (point-max)) + (new-word (if (atom replace) + replace + (car replace))) + (cursor-location (+ (- (length word) (- end start)) + cursor-location))) + (if (not (equal new-word (car poss))) + (progn + (delete-region start end) + (goto-char start) + (funcall flyspell-insert-function new-word) + (if flyspell-abbrev-p + (flyspell-define-abbrev word new-word)))) + (flyspell-ajust-cursor-point save cursor-location old-max))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-ajust-cursor-point ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-ajust-cursor-point (save cursor-location old-max) + (if (>= save cursor-location) + (let ((new-pos (+ save (- (point-max) old-max)))) + (goto-char (cond + ((< new-pos (point-min)) + (point-min)) + ((> new-pos (point-max)) + (point-max)) + (t new-pos)))) + (goto-char save))) + +;*---------------------------------------------------------------------*/ +;* flyspell-emacs-popup ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-emacs-popup (event poss word) + "The Emacs popup menu." + (if (not event) + (let* ((mouse-pos (mouse-position)) + (mouse-pos (if (nth 1 mouse-pos) + mouse-pos + (set-mouse-position (car mouse-pos) + (/ (frame-width) 2) 2) + (unfocus-frame) + (mouse-position)))) + (setq event (list (list (car (cdr mouse-pos)) + (1+ (cdr (cdr mouse-pos)))) + (car mouse-pos))))) + (let* ((corrects (if flyspell-sort-corrections + (sort (car (cdr (cdr poss))) 'string<) + (car (cdr (cdr poss))))) + (cor-menu (if (consp corrects) + (mapcar (lambda (correct) + (list correct correct)) + corrects) + '())) + (affix (car (cdr (cdr (cdr poss))))) + (base-menu (let ((save (if (consp affix) + (list + (list (concat "Save affix: " (car affix)) + 'save) + '("Accept (session)" session) + '("Accept (buffer)" buffer)) + '(("Save word" save) + ("Accept (session)" session) + ("Accept (buffer)" buffer))))) + (if (consp cor-menu) + (append cor-menu (cons "" save)) + save))) + (menu (cons "flyspell correction menu" base-menu))) + (car (x-popup-menu event + (list (format "%s [%s]" word (or ispell-local-dictionary + ispell-dictionary)) + menu))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-xemacs-popup ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-xemacs-popup (event poss word cursor-location start end save) + "The XEmacs popup menu." + (let* ((corrects (if flyspell-sort-corrections + (sort (car (cdr (cdr poss))) 'string<) + (car (cdr (cdr poss))))) + (cor-menu (if (consp corrects) + (mapcar (lambda (correct) + (vector correct + (list 'flyspell-xemacs-correct + correct + (list 'quote poss) + word + cursor-location + start + end + save) + t)) + corrects) + '())) + (affix (car (cdr (cdr (cdr poss))))) + (menu (let ((save (if (consp affix) + (vector + (concat "Save affix: " (car affix)) + (list 'flyspell-xemacs-correct + ''save + (list 'quote poss) + word + cursor-location + start + end + save) + t) + (vector + "Save word" + (list 'flyspell-xemacs-correct + ''save + (list 'quote poss) + word + cursor-location + start + end + save) + t))) + (session (vector "Accept (session)" + (list 'flyspell-xemacs-correct + ''session + (list 'quote poss) + word + cursor-location + start + end + save) + t)) + (buffer (vector "Accept (buffer)" + (list 'flyspell-xemacs-correct + ''buffer + (list 'quote poss) + word + cursor-location + start + end + save) + t))) + (if (consp cor-menu) + (append cor-menu (list "-" save session buffer)) + (list save session buffer))))) + (popup-menu (cons (format "%s [%s]" word (or ispell-local-dictionary + ispell-dictionary)) + menu)))) + +;*---------------------------------------------------------------------*/ +;* Some example functions for real autocorrecting */ +;*---------------------------------------------------------------------*/ +(defun flyspell-maybe-correct-transposition (beg end poss) + "Check replacements for transposed characters. + +If the text between BEG and END is equal to a correction suggested by +Ispell, after transposing two adjacent characters, correct the text, +and return t. + +The third arg POSS is either the symbol 'doublon' or a list of +possible corrections as returned by 'ispell-parse-output'. + +This function is meant to be added to 'flyspell-incorrect-hook'." + (when (consp poss) + (catch 'done + (save-excursion + (goto-char (1+ beg)) + (while (< (point) end) + (transpose-chars 1) + (when (member (buffer-substring beg end) (car (cdr (cdr poss)))) + (throw 'done t)) + (transpose-chars -1) + (forward-char)) + nil)))) + +(defun flyspell-maybe-correct-doubling (beg end poss) + "Check replacements for doubled characters. + +If the text between BEG and END is equal to a correction suggested by +Ispell, after removing a pair of doubled characters, correct the text, +and return t. + +The third arg POSS is either the symbol 'doublon' or a list of +possible corrections as returned by 'ispell-parse-output'. + +This function is meant to be added to 'flyspell-incorrect-hook'." + (when (consp poss) + (catch 'done + (save-excursion + (let ((last (char-after beg)) + this) + (goto-char (1+ beg)) + (while (< (point) end) + (setq this (char-after)) + (if (not (char-equal this last)) + (forward-char) + (delete-char 1) + (when (member (buffer-substring beg (1- end)) (car (cdr (cdr poss)))) + (throw 'done t)) + ;; undo + (insert-char this 1)) + (setq last this)) + nil))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-already-abbrevp ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-already-abbrevp (table word) + (let ((sym (abbrev-symbol word table))) + (and sym (symbolp sym)))) + +;*---------------------------------------------------------------------*/ +;* flyspell-change-abbrev ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-change-abbrev (table old new) + (set (abbrev-symbol old table) new)) + +;*---------------------------------------------------------------------*/ +;* flyspell-auto-correct-previous-word advice ... */ +;*---------------------------------------------------------------------*/ +(defadvice flyspell-auto-correct-previous-word + (around easymacs-flyspell-auto-correct) + "Correct current word if misspelled, else previous + misspelling. Protect against accidentally changing a word + that cannot be seen, because it is somewhere off the screen." + (let ((top) (bot)) + (save-excursion + (move-to-window-line 0) + (setq top (point)) + (move-to-window-line -1) + (setq bot (point))) + (save-restriction + (narrow-to-region top bot) + (save-excursion + (re-search-forward "\\s \\|\\'" nil t) + (overlay-recenter (point)) + ad-do-it)))) + +(ad-activate 'flyspell-auto-correct-previous-word) + +(provide 'flyspell) +;;; flyspell.el ends here +;;; </pre> diff --git a/lisp/general.el b/lisp/general.el index 5e066c4..9e8586a 100644 --- a/lisp/general.el +++ b/lisp/general.el @@ -22,8 +22,8 @@ ;; Margin (global-linum-mode 1) - ;; (require 'minimap) - ;; (minimap-mode 1) + (require 'minimap) + (minimap-mode 1) (require 'perfect-margin) (perfect-margin-mode 1) @@ -51,13 +51,47 @@ (setq neo-theme (if (display-graphic-p) 'icons 'arrow)) ;; Smooth scroll - (require 'smooth-scrolling) - (smooth-scrolling-mode 1) - + (setq redisplay-dont-pause t + scroll-margin 1 + scroll-step 1 + scroll-conservatively 10000 + scroll-preserve-screen-position 1) + ;; Show flycheck always and after save (use-package flycheck :ensure t) (global-flycheck-mode) (add-hook 'after-init-hook #'global-flycheck-mode) + + ;; Emojis + (use-package emojify + :config + (when (member "Segoe UI Emoji" (font-family-list)) + (set-fontset-font + t 'symbol (font-spec :family "Segoe UI Emoji") nil 'prepend)) + (setq emojify-display-style 'unicode) + (setq emojify-emoji-styles '(unicode)) + (bind-key* (kbd "C-c e") #'emojify-insert-emoji)) ; override binding in any mode + + ;; == company-mode == + (use-package company + :ensure t + :defer t + :init (add-hook 'after-init-hook 'global-company-mode) + :config + (use-package company-irony :ensure t :defer t) + (setq company-idle-delay nil + company-minimum-prefix-length 2 + company-show-numbers t + company-tooltip-limit 20 + company-dabbrev-downcase nil + company-backends '((company-irony company-gtags)) + ) + :bind ("C-;" . company-complete-common) + ) + + ;; Flycheck + (eval-after-load 'flycheck + '(add-hook 'flycheck-mode-hook #'flycheck-irony-setup)) ) (provide 'general) diff --git a/lisp/js-mode-custom.el b/lisp/js-mode-custom.el index 7f4d396..094d613 100644 --- a/lisp/js-mode-custom.el +++ b/lisp/js-mode-custom.el @@ -1,12 +1,13 @@ (defun setup-js() (setq js-indent-level 2) - ) + ) +(add-to-list 'auto-mode-alist '("\\.jsx$" . web-mode)) (require 'js2-mode) (require 'js2-refactor) (require 'js2-highlight-vars) (require 'company) -;(add-hook 'js-mode-hook 'js2-minor-mode) +(require 'flycheck) (add-to-list 'auto-mode-alist '("\\.js\\'" . js2-mode)) (add-hook 'js2-mode-hook #'js2-imenu-extras-mode) (add-hook 'js2-mode-hook 'ac-js2-mode) @@ -14,7 +15,21 @@ (add-hook 'js2-mode-hook 'js2-highlight-vars-mode) (add-hook 'js2-mode-hook 'setup-js) (js2r-add-keybindings-with-prefix "C-c C-r") +(add-hook 'js2-mode-hook 'ac-js2-mode) (add-to-list 'company-backends 'ac-js2-company) +(defun my/use-eslint-from-node-modules () + (let* ((root (locate-dominating-file + (or (buffer-file-name) default-directory) + "node_modules")) + (eslint (and root + (expand-file-name "node_modules/eslint/bin/eslint.js" + root)))) + (when (and eslint (file-executable-p eslint)) + (setq-local flycheck-javascript-eslint-executable eslint)))) +(add-hook 'flycheck-mode-hook #'my/use-eslint-from-node-modules) +(flycheck-add-mode 'javascript-eslint 'web-mode) + (provide 'js-mode-custom) +;; js-mode-custom.el ends here diff --git a/lisp/smooth-scrolling.el b/lisp/smooth-scrolling.el deleted file mode 100644 index 98df30e..0000000 --- a/lisp/smooth-scrolling.el +++ /dev/null @@ -1,327 +0,0 @@ -;;; smooth-scrolling.el --- Make emacs scroll smoothly -;; -;; Copyright (c) 2007-2016 Adam Spiers -;; -;; Filename: smooth-scrolling.el -;; Description: Make emacs scroll smoothly -;; Author: Adam Spiers <emacs-ss@adamspiers.org> -;; Jeremy Bondeson <jbondeson@gmail.com> -;; Ryan C. Thompson <rct+github@thompsonclan.org> -;; Maintainer: Adam Spiers <emacs-ss@adamspiers.org> -;; Homepage: http://github.com/aspiers/smooth-scrolling/ -;; Version: 2.0.0 -;; Keywords: convenience -;; GitHub: http://github.com/aspiers/smooth-scrolling/ - -;; This file is not part of GNU Emacs - -;;; License: -;; -;; This program 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 -;; of the License, or (at your option) any later version. -;; -;; This program 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 this program; if not, write to the Free Software -;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; To interactively toggle the mode on / off: -;; -;; M-x smooth-scrolling-mode -;; -;; To make the mode permanent, put this in your .emacs: -;; -;; (require 'smooth-scrolling) -;; (smooth-scrolling-mode 1) -;; -;; This package offers a global minor mode which make emacs scroll -;; smoothly. It keeps the point away from the top and bottom of the -;; current buffer's window in order to keep lines of context around -;; the point visible as much as possible, whilst minimising the -;; frequency of sudden scroll jumps which are visually confusing. -;; -;; This is a nice alternative to all the native `scroll-*` custom -;; variables, which unfortunately cannot provide this functionality -;; perfectly. For example, when using the built-in variables, clicking -;; with the mouse in the margin will immediately scroll the window to -;; maintain the margin, so the text that you clicked on will no longer be -;; under the mouse. This can be disorienting. In contrast, this mode -;; will not do any scrolling until you actually move up or down a line. -;; -;; Also, the built-in margin code does not interact well with small -;; windows. If the margin is more than half the window height, you get -;; some weird behavior, because the point is always hitting both the top -;; and bottom margins. This package auto-adjusts the margin in each -;; buffer to never exceed half the window height, so the top and bottom -;; margins never overlap. - -;; See the README.md for more details. - -;;; Change Log: -;; 27 Feb 2016 -- v2.0.0 -;; * Converted to global minor mode "smooth-scrolling-mode". This -;; means that simply loading the file no longer enables smooth -;; scrolling; you must also enable the mode. -;; * Internal code restructuring that should improve some edge -;; cases, but otherwise have no user-visible effects. -;; 19 Dec 2013 -- v1.0.4 -;; * Disabled scrolling while a keyboard macro is executing in -;; order to prevent a premature termination of the macro by -;; the mode throwing an error such as "End of Buffer" -;; 02 Jun 2013 -- v1.0.3 -;; * Fixed Issue #3 where bounds checking was not being performed -;; prior to calls to 'count-lines' and 'count-screen-lines' -;; functions. -;; 14 Apr 2013 -- v1.0.2 -;; * Adam Spiers GitHub account now houses the canonical -;; repository. -;; 06 Dec 2011 -- v1.0.1 -;; * Altered structure to conform to package.el standards. -;; * Restructured code to group settings changes -;; * Set "redisplay-dont-pause" to true. -;; ?? ??? 2007 -- v1.0.0 -;; * Original version from Adam Spiers - -;;; Code: - -;;;_ + internal variables -(defvar smooth-scroll-orig-scroll-margin nil) - -;;;_ + defcustoms - -(defgroup smooth-scrolling nil - "Make emacs scroll smoothly" - :group 'convenience) - -;;;###autoload -(define-minor-mode smooth-scrolling-mode - "Make emacs scroll smoothly" - :init-value nil - :global t - :group 'smooth-scrolling - (if smooth-scrolling-mode - (setq smooth-scroll-orig-scroll-margin scroll-margin - scroll-margin 0) - (setq scroll-margin smooth-scroll-orig-scroll-margin - smooth-scroll-orig-scroll-margin nil))) - -;;;###autoload -(defcustom smooth-scroll-margin 10 - "Number of lines of visible margin at the top and bottom of a window. -If the point is within these margins, then scrolling will occur -smoothly for `previous-line' at the top of the window, and for -`next-line' at the bottom. - -This is very similar in its goal to `scroll-margin'. However, it -is implemented by activating `smooth-scroll-down' and -`smooth-scroll-up' advise via `defadvice' for `previous-line' and -`next-line' respectively. As a result it avoids problems -afflicting `scroll-margin', such as a sudden jump and unexpected -highlighting of a region when the mouse is clicked in the margin. - -Scrolling only occurs when the point is closer to the window -boundary it is heading for (top or bottom) than the middle of the -window. This is to intelligently handle the case where the -margins cover the whole buffer (e.g. `smooth-scroll-margin' set -to 5 and `window-height' returning 10 or less). - -See also `smooth-scroll-strict-margins'." - :type 'integer - :group 'smooth-scrolling) - -;;;###autoload -(defcustom smooth-scroll-strict-margins t - "If true, the advice code supporting `smooth-scroll-margin' -will use `count-screen-lines' to determine the number of -*visible* lines between the point and the window top/bottom, -rather than `count-lines' which obtains the number of actual -newlines. This is because there might be extra newlines hidden -by a mode such as folding-mode, outline-mode, org-mode etc., or -fewer due to very long lines being displayed wrapped when -`truncate-lines' is nil. - -However, using `count-screen-lines' can supposedly cause -performance issues in buffers with extremely long lines. Setting -`cache-long-line-scans' may be able to address this; -alternatively you can set this variable to nil so that the advice -code uses `count-lines', and put up with the fact that sometimes -the point will be allowed to stray into the margin." - :type 'boolean - :group 'smooth-scrolling) - -;;;_ + helper functions -(defmacro smooth-scroll-ignore-scroll-errors (&rest body) - "Like `progn', but ignores beginning/end of line errors. - -If BODY encounters such an error, further evaluation is stopped -and this form returns nil. Any other error is raised as normal." - (declare (indent 0)) - `(condition-case err - (progn ,@body) - (end-of-buffer nil) - (beginning-of-buffer nil) - (error (signal (car err) (cdr err))))) - -(defun smooth-scroll-line-beginning-position () - "Return position at beginning of (logical/visual) line. - -If `smooth-scroll-strict-margins' is non-nil, this looks to the -beginning of the visual line. Otherwise it uses the beginning of -the logical line." - (save-excursion - ;; Cannot use `line-beginning-position' here because there is no - ;; visual-line equivalent. - (funcall (if smooth-scroll-strict-margins - #'beginning-of-visual-line - #'beginning-of-line)) - (point))) - -(defun smooth-scroll-count-lines (start end) - "Return number of (logical/visual) lines between START and END. - -If `smooth-scroll-strict-margins' is non-nil, this counts visual -lines. Otherwise it counts logical lines. - -If END is less than START, this returns zero, so it is important -to pass them in order." - (if (< end start) - 0 - (funcall (if smooth-scroll-strict-margins - #'count-screen-lines - #'count-lines) - start end))) - -(defun smooth-scroll-lines-above-point () - "Return the number of lines in window above point. - -This does not include the line that point is on." - (smooth-scroll-count-lines (window-start) - (smooth-scroll-line-beginning-position))) - -(defun smooth-scroll-lines-below-point () - "Return the number of lines in window above point. - -This does not include the line that point is on." - ;; We don't rely on `window-end' because if we are scrolled near the - ;; end of the buffer, it will only give the number of lines - ;; remaining in the file, not the number of lines to the bottom of - ;; the window. - (- (window-height) 2 (smooth-scroll-lines-above-point))) - -(defun smooth-scroll-window-allowed-margin () - "Return the maximum allowed margin above or below point. - -This only matters for windows whose height is -`smooth-scroll-margin' * 2 lines or less." - ;; We subtract 1 for the modeline, which is counted in - ;; `window-height', and one more for the line that point is on. Then - ;; we divide by 2, rouding down. - (/ (- (window-height) 2) 2)) - -(defsubst window-is-at-bob-p () - "Returns non-nil if `(window-start)' is 1 (or less)." - (<= (window-start) 1)) - -;;;_ + main function -(defun do-smooth-scroll () - "Ensure that point is not to close to window edges. - -This function scrolls the window until there are at least -`smooth-scroll-margin' lines between the point and both the top -and bottom of the window. If this is not possible because the -window is too small, th window is scrolled such that the point is -roughly centered within the window." - (interactive) - (when smooth-scrolling-mode - (let* ((desired-margin - ;; For short windows, we reduce `smooth-scroll-margin' to - ;; half the window height minus 1. - (min (smooth-scroll-window-allowed-margin) - smooth-scroll-margin)) - (upper-margin (smooth-scroll-lines-above-point)) - (lower-margin (smooth-scroll-lines-below-point))) - (smooth-scroll-ignore-scroll-errors - (cond - ((< upper-margin desired-margin) - (save-excursion - (dotimes (i (- desired-margin upper-margin)) - (scroll-down 1)))) - ((< lower-margin desired-margin) - (save-excursion - (dotimes (i (- desired-margin lower-margin)) - (scroll-up 1))))))))) - -;;;_ + advice setup - -;;;###autoload -(defmacro enable-smooth-scroll-for-function (func) - "Define advice on FUNC to do smooth scrolling. - -This adds after advice with name `smooth-scroll' to FUNC. - -Note that the advice will not have an effect unless -`smooth-scrolling-mode' is enabled." - `(defadvice ,func (after smooth-scroll activate) - "Do smooth scrolling after command finishes. - -This advice only has an effect when `smooth-scrolling-mode' is -enabled. See `smooth-scrolling-mode' for details. To remove this -advice, use `disable-smooth-scroll-for-function'." - (do-smooth-scroll))) - -(defmacro enable-smooth-scroll-for-function-conditionally (func cond) - "Define advice on FUNC to do smooth scrolling conditionally. - -This adds after advice with name `smooth-scroll' to FUNC. The -advice runs smooth scrolling if expression COND evaluates to -true. COND is included within the advice and therefore has access -to all of FUNC's arguments. - -Note that the advice will not have an effect unless -`smooth-scrolling-mode' is enabled." - (declare (indent 1)) - `(defadvice ,func (after smooth-scroll activate) - ,(format "Do smooth scrolling conditionally after command finishes. - -Smooth sccrolling will only be performed if the following -expression evaluates to true after the function has run: - -%s -This advice only has an effect when `smooth-scrolling-mode' is -enabled. See `smooth-scrolling-mode' for details. To remove this -advice, use `disable-smooth-scroll-for-function'." - (pp-to-string cond)) - (when ,cond - (do-smooth-scroll)))) - -(defmacro disable-smooth-scroll-for-function (func) - "Delete smooth-scroll advice for FUNC." - ;; This doesn't actually need to be a macro, but it is one for - ;; consistency with the enabling macro. Errors are ignored in case - ;; the advice has already been removed. - `(ignore-errors - (ad-remove-advice ',func 'after 'smooth-scroll) - (ad-activate ',func))) - -(progn - (enable-smooth-scroll-for-function previous-line) - (enable-smooth-scroll-for-function next-line) - (enable-smooth-scroll-for-function dired-previous-line) - (enable-smooth-scroll-for-function dired-next-line) - (enable-smooth-scroll-for-function isearch-repeat) - (enable-smooth-scroll-for-function-conditionally scroll-up-command - (not (window-is-at-bob-p))) - (enable-smooth-scroll-for-function-conditionally scroll-down-command - (not (window-is-at-bob-p)))) - -;;;_ + provide -(provide 'smooth-scrolling) -;;; smooth-scrolling.el ends here diff --git a/lisp/text.el b/lisp/text.el index 498a373..4e1f8bf 100644 --- a/lisp/text.el +++ b/lisp/text.el @@ -4,4 +4,9 @@ (global-hl-line-mode 0) ) +;;(require 'flyspell) +;;(autoload 'flyspell-mode "flyspell" "On-the-fly spelling checker." t) +;;(add-hook 'text-mode flyspell-mode) + + (provide 'text) |