1 files changed, 286 insertions, 6 deletions

@@ -9,12 +9,188 @@
 ;;
 ;; For the tenth time!
 
-;;; Packages
+;;; Code:
+
+(load (locate-user-emacs-file "private"))
+
+
+;;; Definitions:
+
+(defun other-window-or-switch-buffer (&optional arg)
+  "Switch to the other window.
+If a window is the only buffer on a frame, switch buffer.  When
+run with \\[universal-argument], unconditionally switch buffer."
+  (interactive "P")
+  (if (or arg (one-window-p))
+      (switch-to-buffer (other-buffer) nil t)
+    (other-window 1)))
+
+(defun cycle-spacing@ (&optional n)
+  ;; `cycle-spacing' is wildly different in 29.1 over 28.
+  "Negate N argument on `cycle-spacing'.
+That is, with a positive N, deletes newlines as well, leaving -N
+spaces.          If N is negative, it will not delete newlines and leave
+N spaces."
+  (interactive "*p")
+  (cycle-spacing (- n)))
+
+(defun first-frame@set-fonts ()
+  (remove-hook 'server-after-make-frame-hook
+               #'first-frame@set-fonts)
+  (face-spec-set 'default
+                 `((t :family "Recursive Mono Casual Static"
+                      :height 110)))
+  ;; Emojis
+  (cl-loop with ffl = (font-family-list)
+           for font in '("Noto Emoji" "Noto Color Emoji"
+                         "Segoe UI Emoji" "Apple Color Emoji"
+                         "FreeSans" "FreeMono" "FreeSerif"
+                         "Unifont" "Symbola")
+           if (member font ffl)
+           do (set-fontset-font t 'symbol font))
+  ;; International fonts
+  (cl-loop with ffl = (font-family-list)
+           for (charset . font)
+           in '((latin . "Noto Sans")
+                (han . "Noto Sans CJK SC Regular")
+                (kana . "Noto Sans CJK JP Regular")
+                (hangul . "Noto Sans CJK KR Regular")
+                (cjk-misc . "Noto Sans CJK KR Regular")
+                (khmer . "Noto Sans Khmer")
+                (lao . "Noto Sans Lao")
+                (burmese . "Noto Sans Myanmar")
+                (thai . "Noto Sans Thai")
+                (ethiopic . "Noto Sans Ethiopic")
+                (hebrew . "Noto Sans Hebrew")
+                (arabic . "Noto Sans Arabic")
+                (gujarati . "Noto Sans Gujarati")
+                (devanagari . "Noto Sans Devanagari")
+                (kannada . "Noto Sans Kannada")
+                (malayalam . "Noto Sans Malayalam")
+                (oriya . "Noto Sans Oriya")
+                (sinhala . "Noto Sans Sinhala")
+                (tamil . "Noto Sans Tamil")
+                (telugu . "Noto Sans Telugu")
+                (tibetan . "Noto Sans Tibetan"))
+           if (member font ffl)
+           do (set-fontset-font t charset font))
+  ;; XXX: tab-bar does a weird thing, so i set it up here....
+  (setopt tab-bar-show t)
+  (tab-bar-mode))
+
+(defun renz/sort-by-alpha-length (elems)
+  "Sort ELEMS first alphabetically, then by length."
+  (sort elems (lambda (c1 c2)
+                (or (string-version-lessp c1 c2)
+                    (< (length c1) (length c2))))))
+
+(defun renz/sort-by-history (elems)
+  "Sort ELEMS by minibuffer history.
+Use `mct-sort-sort-by-alpha-length' if no history is available."
+  (if-let ((hist (and (not (eq minibuffer-history-variable t))
+                      (symbol-value minibuffer-history-variable))))
+      (minibuffer--sort-by-position hist elems)
+    (renz/sort-by-alpha-length elems)))
+
+(defun renz/completion-category ()
+  "Return completion category."
+  (when-let ((window (active-minibuffer-window)))
+    (with-current-buffer (window-buffer window)
+      (completion-metadata-get
+       (completion-metadata (buffer-substring-no-properties
+                             (minibuffer-prompt-end)
+                             (max (minibuffer-prompt-end) (point)))
+                            minibuffer-completion-table
+                            minibuffer-completion-predicate)
+       'category))))
+
+(defun renz/sort-multi-category (elems)
+  "Sort ELEMS per completion category."
+  (pcase (renz/completion-category)
+    ('nil elems) ; no sorting
+    ('kill-ring elems)
+    ('project-file (renz/sort-by-alpha-length elems))
+    (_ (renz/sort-by-history elems))))
+
+(defvar no-tabs-modes '(emacs-lisp-mode
+                        lisp-mode
+                        scheme-mode
+                        python-mode
+                        haskell-mode)
+  "Modes /not/ to indent with tabs.")
+
+(defun indent-tabs-mode-maybe ()
+  (if (apply #'derived-mode-p no-tabs-modes)
+      (indent-tabs-mode -1)
+    (indent-tabs-mode 1)))
+
+(define-minor-mode truncate-lines-mode
+  "Buffer-local mode to toggle `truncate-lines'."
+  :lighter ""
+  (setq-local truncate-lines truncate-lines-mode))
+
+;;; Region or buffer stuff
+
+(defun call-with-region-or-buffer (fn &rest _r)
+  "Call function FN with current region or buffer.
+Good to use for :around advice."
+  (if (region-active-p)
+      (funcall fn (region-beginning) (region-end))
+    (funcall fn (point-min) (point-max))))
+
+(defun delete-trailing-whitespace-except-current-line ()
+  (save-excursion
+    (delete-trailing-whitespace (point-min)
+                                (line-beginning-position))
+    (delete-trailing-whitespace (line-end-position)
+                                (point-max))))
+
+(defun create-missing-directories ()
+  "Automatically create missing directories."
+  (let ((target-dir (file-name-directory buffer-file-name)))
+    (unless (file-exists-p target-dir)
+      (make-directory target-dir :parents))))
+
+
+(defun vc-remote-off ()
+  "Turn VC off when remote."
+  (when (file-remote-p (buffer-file-name))
+    (setq-local vc-handled-backends nil)))
+
+(defun +titlecase-sentence-style-dwim (&optional arg)
+  "Titlecase a sentence.
+With prefix ARG, toggle the value of
+`titlecase-downcase-sentences' before sentence-casing."
+  (interactive "P")
+  (let ((titlecase-downcase-sentences (if arg (not titlecase-downcase-sentences)
+                                        titlecase-downcase-sentences)))
+    (titlecase-dwim 'sentence)))
+
+(defun +titlecase-org-headings ()
+  (interactive)
+  (require 'org)
+  (save-excursion
+    (goto-char (point-min))
+    ;; See also `org-map-tree'.  I'm not using that function because I want to
+    ;; skip the first headline.  A better solution would be to patch
+    ;; `titlecase-line' to ignore org-mode metadata (TODO cookies, tags, etc).
+    (let ((level (funcall outline-level))
+          (org-special-ctrl-a/e t))
+      (while (and (progn (outline-next-heading)
+                         (> (funcall outline-level) level))
+                  (not (eobp)))
+        (titlecase-region (progn (org-beginning-of-line) (point))
+                          (progn (org-end-of-line) (point)))))))
+
+
+;;; Packages:
 
 (require 'package)
 (add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/") t)
 (package-initialize)
 
+;; Install packages here. Acutal configuration is done in the Configuration
+;; section.
 (dolist (pkg `(consult
                marginalia
                visual-fill-column
@@ -31,9 +207,95 @@
       (package-refresh-contents)
       (package-install pkg))))
 
-(load (locate-user-emacs-file "definitions"))
-(load (locate-user-emacs-file "packages"))
-(load (locate-user-emacs-file "private"))
+(dolist (local-pkg `(scule
+                     frowny
+                     hippie-completing-read
+                     mode-line-bell
+                     titlecase
+                     jabber))
+  (add-to-list 'load-path
+               (expand-file-name
+                (format "~/src/%s.el"
+                        (symbol-name local-pkg)))))
+
+;;; Jabber
+
+(use-package jabber
+  :load-path  "~/src/jabber.el"
+  :defer t
+  :bind-keymap (("C-c j" . jabber-global-keymap))
+  :preface nil
+  (setq-default jabber-chat-buffer-format "*%n*"
+                jabber-browse-buffer-format "*%n*"
+                jabber-groupchat-buffer-format "*%n*"
+                jabber-muc-private-buffer-format "*%n*")
+  :custom-face
+  (jabber-activity-face ((t :inherit jabber-chat-prompt-foreign
+                            :foreground unspecified
+                            :weight normal)))
+  (jabber-activity-personal-face ((t :inherit jabber-chat-prompt-local
+                                     :foreground unspecified
+                                     :weight bold)))
+  (jabber-chat-prompt-local ((t :inherit minibuffer-prompt
+                                :foreground unspecified
+                                :weight normal
+                                :slant italic)))
+  (jabber-chat-prompt-foreign ((t :inherit warning
+                                  :foreground unspecified
+                                  :weight normal)))
+  (jabber-chat-prompt-system ((t :inherit font-lock-doc-face
+                                 :foreground unspecified)))
+  (jabber-rare-time-face ((t :inherit font-lock-comment-face
+                             :foreground unspecified
+                             :underline nil)))
+  :config
+  (require 'jabber-httpupload nil t)
+  (setopt jabber-auto-reconnect t
+          jabber-last-read-marker "~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~"
+          jabber-muc-decorate-presence-patterns
+          '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$" . nil)
+            ("Mode #.*" . jabber-muc-presence-dim)
+            ("." . jabber-muc-presence-dim))
+          jabber-activity-make-strings #'jabber-activity-make-strings-shorten
+          jabber-rare-time-format
+          (format " - - - - - %%H:%d %%F"
+                  (let ((min (string-to-number (format-time-string "%M"))))
+                    (* 5 (floor min 5))))
+          jabber-muc-header-line-format '(" " jabber-muc-topic))
+
+  (setopt jabber-groupchat-prompt-format "%n.  "
+          jabber-chat-local-prompt-format "%n.  "
+          jabber-chat-foreign-prompt-format "%n.  "
+          jabber-muc-private-foreign-prompt-format "%g/%n.  ")
+
+  (keymap-global-set "C-c C-SPC" #'jabber-activity-switch-to)
+  (map-keymap (lambda (key command)
+                (define-key jabber-global-keymap (vector (+ key #x60)) command))
+              jabber-global-keymap)
+  (keymap-global-set "C-x C-j" #'dired-jump)
+
+  (add-hook 'jabber-post-connect-hooks #'jabber-enable-carbons)
+  (remove-hook 'jabber-alert-muc-hooks 'jabber-muc-echo)
+  (remove-hook 'jabber-alert-presence-hooks 'jabber-presence-echo)
+  (add-hook 'jabber-chat-mode-hook 'visual-line-mode)
+  (add-hook 'jabber-chat-mode-hook (defun jabber-no-position ()
+                                     (setq-local mode-line-position nil)))
+
+  (add-hook 'jabber-alert-muc-hooks
+            (defun jabber@highlight-acdw (&optional _ _ buf _ _)
+              (when buf
+                (with-current-buffer buf
+                  (let ((regexp (rx word-boundary
+                                    "acdw" ; maybe get from the config?
+                                    word-boundary)))
+                    (hi-lock-unface-buffer regexp)
+                    (highlight-regexp regexp 'jabber-chat-prompt-local))))))
+
+  (when (fboundp 'jabber-chat-update-focus)
+    (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus)))
+
+
+;;; Configuration:
 
 (setopt custom-file (locate-user-emacs-file "custom.el"))
 (load custom-file :noerror)
@@ -355,11 +617,12 @@
 (defun tab-bar-end-space ()
   `((end menu-item " " ignore)))
 
-(setopt tab-bar-show t)
+
 (add-to-list 'tab-bar-format 'tab-bar-format-align-right :append)
 (add-to-list 'tab-bar-format 'tab-bar-format-global :append)
 (add-to-list 'tab-bar-format 'tab-bar-end-space :append)
-(tab-bar-mode)
+;;(setopt tab-bar-show t)
+;;(tab-bar-mode) ; done after setting fonts
 
 ;;; Org mode
 
@@ -472,3 +735,20 @@ ORG-EXPORT-ARGS are passed to `org-export-to-file'."
 
 (keymap-global-set "C-x C-b" #'ibuffer)
 (add-hook 'ibuffer-hook #'hl-line-mode)
+
+(autoload 'scule-map "scule" nil nil 'keymap)
+(keymap-global-set "M-c" 'scule-map)
+(with-eval-after-load 'scule
+  (keymap-set scule-map "M-t" #'titlecase-dwim))
+
+;; Use M-u for prefix keys
+(keymap-global-set "M-u" #'universal-argument)
+(keymap-set universal-argument-map "M-u" #'universal-argument-more)
+
+(add-hook 'jabber-chat-mode-hook #'frowny-mode)
+
+(keymap-global-set "M-/" #'hippie-completing-read)
+
+(setopt mode-line-bell-flash-time 0.25)
+(autoload 'mode-line-bell-mode "mode-line-bell" nil t)
+(mode-line-bell-mode)