;;; pkg-social.el --- Social media and security tools -*- lexical-binding: t -*-
;; Copyright (C) 2026 Cytrogen
;; This file contains:
;; - Mastodon client configuration
;; - GPG/EPA security setup
;; - Social media integrations
;;; Commentary:
;; Configuration for social media tools and security features.
;; Includes comprehensive GPG setup with Windows compatibility.
;;; Code:
;; Dependencies
(require 'cl-lib) ; 确保cl-some函数可用
;; GPG Configuration
;; Cross-platform GPG setup with error handling
(defun my/setup-gpg ()
"配置GPG，优先查找Windows常见安装路径。"
(interactive)
(require 'epa-file)
;; 1. 定义查找列表：优先找用户实际安装位置
(let* ((candidates '("D:/GnuPG/bin/gpg.exe" ; 用户实际安装位置 (最高优先级)
"C:/Program Files (x86)/GnuPG/bin/gpg.exe" ; Gpg4win 默认路径 (64位系统)
"C:/Program Files/GnuPG/bin/gpg.exe" ; Gpg4win 备选路径
"gpg")) ; 系统 PATH
;; 找到第一个存在的路径
(found-gpg (cl-some (lambda (path)
(if (string-match-p "/" path)
(and (file-exists-p path) path)
(executable-find path)))
candidates)))
(if found-gpg
(progn
;; Add GPG path to exec-path for proper discovery
(let ((gpg-dir (file-name-directory found-gpg)))
(when (and gpg-dir (not (member gpg-dir exec-path)))
(add-to-list 'exec-path gpg-dir)))
;; Use custom-set-variables for EPA configuration (StackOverflow solution)
(custom-set-variables
`(epg-gpg-program ,found-gpg)
'(epa-pinentry-mode 'loopback)
'(epg-debug t)
`(epg-gpg-home-directory ,(or (getenv "GNUPGHOME")
(expand-file-name "~/.gnupg")))
'(epa-file-cache-passphrase-for-symmetric-encryption t)
'(epa-file-select-keys 'silent)
'(epa-file-encrypt-to nil)
'(epa-armor t)
'(epg-user-id nil))
;; Enable encrypted file support
(require 'epa-file)
(epa-file-enable)
(message "GPG configured successfully. Path: %s" found-gpg))
;; GPG not found handling
(message "Warning: GPG executable not found. Mastodon will not be able to save credentials securely.")
(message "Please check if Gpg4win is installed and confirm the installation path."))))
;; GPG Management Tools
(defun my/check-or-create-gpg-keys ()
"检测GPG密钥，如果没有则提示创建。"
(interactive)
(when epg-gpg-program
(condition-case err
(let* ((context (epg-make-context))
(keys (epg-list-keys context)))
(if keys
(progn
(message "Found %d GPG keys" (length keys))
(dolist (key keys)
(let ((user-ids (epg-key-user-id-list key)))
(when user-ids
(message "Key: %s" (epg-user-id-string (car user-ids)))))))
;; 没有密钥，提供创建选项
(when (yes-or-no-p "未找到GPG密钥，是否创建新密钥对? ")
(my/create-gpg-keypair))))
(error
(message "Error checking GPG keys: %s" (error-message-string err))))))
(defun my/create-gpg-keypair ()
"创建新的GPG密钥对。"
(interactive)
(let* ((name (read-string "输入姓名: "))
(email (read-string "输入邮箱: "))
(passphrase (read-passwd "输入密码(可选，直接回车跳过): "))
(batch-config (format "%%echo Generating GPG key
Key-Type: RSA
Key-Length: 2048
Subkey-Type: RSA
Subkey-Length: 2048
Name-Real: %s
Name-Email: %s
%s
Expire-Date: 0
%%commit
%%echo Done"
name
email
(if (string-empty-p passphrase)
"%no-protection"
(format "Passphrase: %s" passphrase))))
(temp-file (make-temp-file "gpg-batch" nil ".txt")))
(with-temp-file temp-file
(insert batch-config))
(message "Creating GPG keypair, please wait...")
(let ((result (shell-command (format "\"%s\" --batch --generate-key \"%s\""
epg-gpg-program temp-file))))
(delete-file temp-file)
(if (= result 0)
(progn
(message "GPG keypair created successfully!")
(my/check-or-create-gpg-keys))
(message "Failed to create GPG keypair. Please check configuration")))))
(defun my/check-gpg-config ()
"检查和修复GPG配置文件。"
(interactive)
(let* ((gpg-home (or (getenv "GNUPGHOME")
(expand-file-name "~/.gnupg")))
(gpg-conf (expand-file-name "gpg.conf" gpg-home))
(gpg-agent-conf (expand-file-name "gpg-agent.conf" gpg-home)))
;; 确保.gnupg目录存在
(unless (file-directory-p gpg-home)
(make-directory gpg-home t)
(message "Created GPG home directory: %s" gpg-home))
;; 检查和创建gpg.conf
(unless (file-exists-p gpg-conf)
(with-temp-file gpg-conf
(insert "# GPG配置文件\n")
(insert "use-agent\n")
(insert "armor\n")
(insert "keyid-format long\n"))
(message "Created gpg.conf configuration file"))
;; 检查和创建gpg-agent.conf (Windows需要)
(unless (file-exists-p gpg-agent-conf)
(with-temp-file gpg-agent-conf
(insert "# GPG Agent配置文件\n")
(insert "default-cache-ttl 28800\n")
(insert "max-cache-ttl 86400\n")
(when (eq system-type 'windows-nt)
(insert "pinentry-program C:/Program Files (x86)/Gpg4win/bin/pinentry-basic.exe\n")))
(message "Created gpg-agent.conf configuration file"))
(message "GPG configuration check completed")))
(defun my/fix-epa-issues ()
"一键诊断和修复EPA配置问题。"
(interactive)
(message "Starting EPA diagnostics and repair...")
;; 重新配置GPG
(my/setup-gpg)
;; 检查配置文件
(my/check-gpg-config)
;; 检查密钥
(my/check-or-create-gpg-keys)
;; 重新初始化EPA
(when (fboundp 'epa-file-disable)
(epa-file-disable))
(epa-file-enable)
;; 测试EPA功能
(run-with-timer 3 nil (lambda ()
(condition-case err
(progn
(epg-make-context)
(message "EPA repair completed! Please test Mastodon functionality"))
(error
(message "EPA still has issues: %s" (error-message-string err))
(message "Suggestion: manually check GPG installation and key configuration"))))))
;; Initialize GPG configuration
(my/setup-gpg)
;; Mastodon Configuration
;; Social media client with modern UI
(unless (package-installed-p 'mastodon)
(package-install 'mastodon))
(with-eval-after-load 'mastodon
(setq mastodon-instance-url "https://m.otter.homes"
mastodon-active-user "cytrogen")
;; 界面设置
(setq mastodon-client-width-mode nil)
;; --- UI Modernization (Avatars & Images) ---
;; 1. Enable Avatars
(setq mastodon-tl--show-avatars t)
;; 2. Optimize Image Preview
(setq mastodon-media-format-type 'preview)
;; 智能EPA绕过和错误隔离
(defvar my/mastodon-encryption-attempted nil
"记录是否已尝试启用加密。")
(defun my/test-mastodon-encryption ()
"测试Mastodon是否能安全使用GPG加密。"
(condition-case err
(progn
(epg-make-context)
(epg-list-keys (epg-make-context))
t) ; 成功返回t
(error nil))) ; 失败返回nil
;; 根据EPA功能自动选择加密方式
(if (and (not my/mastodon-encryption-attempted)
(my/test-mastodon-encryption))
(progn
(setq mastodon-client-file-encryption t)
(setq my/mastodon-encryption-attempted t)
(message "Mastodon enabled GPG encrypted storage"))
(progn
(setq mastodon-client-file-encryption nil)
(setq my/mastodon-encryption-attempted t)
(message "Mastodon using plaintext storage (EPA unavailable or problematic)")))
;; 运行时错误隔离
(condition-case gpg-err
(when mastodon-client-file-encryption
(when (and epg-gpg-program (file-exists-p epg-gpg-program))
(message "Mastodon GPG configuration validation completed")))
(error
(setq mastodon-client-file-encryption nil) ; 自动fallback到明文
(message "Detected EPA issues, automatically switching to plaintext storage: %s" (error-message-string gpg-err)))))
;; Nerd Icons Integration
(unless (package-installed-p 'nerd-icons)
(package-install 'nerd-icons))
(defun my/verify-nerd-font ()
"Check if Symbols Nerd Font is available."
(interactive)
(let* ((font-name "Symbols Nerd Font Mono")
(font (find-font (font-spec :name font-name))))
(if font
(message "成功! Emacs 已找到字体: %s" font)
(message "失败! Emacs 找不到 '%s'。请确认已选择'为所有用户安装'并重启了 Emacs。" font-name))))
(with-eval-after-load 'nerd-icons
;; (setq nerd-icons-font-family "Your Nerd Font Name")
)
(with-eval-after-load 'mastodon
(require 'nerd-icons)
;; 1. Replace text symbols with Nerd Icons
(setq mastodon-tl--symbols
`((reply . (,(nerd-icons-faicon "nf-fa-reply") . "R"))
(boost . (,(nerd-icons-faicon "nf-fa-retweet") . "B"))
(reblog . (,(nerd-icons-faicon "nf-fa-retweet") . "B"))
(favourite . (,(nerd-icons-faicon "nf-fa-star") . "F"))
(bookmark . (,(nerd-icons-faicon "nf-fa-bookmark") . "K"))
(media . (,(nerd-icons-faicon "nf-fa-file_image_o") . "[media]"))
(verified . (,(nerd-icons-octicon "nf-oct-verified") . "V"))
(locked . (,(nerd-icons-faicon "nf-fa-lock") . "[locked]"))
(private . (,(nerd-icons-faicon "nf-fa-lock") . "[followers]"))
(mention . (,(nerd-icons-faicon "nf-fa-at") . "[mention]"))
(direct . (,(nerd-icons-faicon "nf-fa-envelope") . "[direct]"))
(edited . (,(nerd-icons-faicon "nf-fa-pencil") . "[edited]"))
(update . (,(nerd-icons-faicon "nf-fa-pencil") . "[edited]"))
(status . (,(nerd-icons-faicon "nf-fa-bell") . "[posted]"))
(poll . (,(nerd-icons-faicon "nf-fa-bar_chart") . "[poll]"))
(follow . (,(nerd-icons-faicon "nf-fa-user_plus") . "+"))
(follow_request . (,(nerd-icons-faicon "nf-fa-user_plus") . "+"))
(severed_relationships . (,(nerd-icons-faicon "nf-fa-chain_broken") . "//"))
(moderation_warning . (,(nerd-icons-faicon "nf-fa-exclamation_triangle") . "!!"))
(reply-bar . ("┃" . "|"))))
;; 2. Modernize Faces
;; Use variable width font for main text (if desired)
(add-hook 'mastodon-mode-hook #'variable-pitch-mode)
;; Make headers stand out
(set-face-attribute 'mastodon-display-name-face nil :height 1.2 :weight 'bold)
(set-face-attribute 'mastodon-handle-face nil :height 0.9 :slant 'italic :foreground "gray60")
;; Improve metadata visibility
(set-face-attribute 'mastodon-toot-docs-face nil :height 0.85 :foreground "gray50")
;; Fix alignment for icons if needed
(when (display-graphic-p)
(setq mastodon-tl--enable-proportional-fonts t)))
;; Security Tools
;; Additional security and privacy features
(defun my/check-gpg-status ()
"检查并显示当前GPG配置状态。"
(interactive)
(with-output-to-temp-buffer "*GPG状态检查*"
(princ "=== GPG状态检查 ===\n\n")
;; 使用与my/setup-gpg相同的查找逻辑
(princ "1. GPG程序检查（按优先级顺序）:\n")
(let* ((candidates '("D:/GnuPG/bin/gpg.exe" ; 用户实际安装位置
"C:/Program Files (x86)/GnuPG/bin/gpg.exe"
"C:/Program Files/GnuPG/bin/gpg.exe"
"gpg"))
(found-paths '()))
;; 检查每个候选路径
(dolist (path candidates)
(let ((exists (if (string-match-p "/" path)
(file-exists-p path)
(executable-find path))))
(if exists
(progn
(princ (format " Found: %s\n" path))
(push path found-paths))
(princ (format " ✗ %s\n" path)))))
;; 显示当前使用的路径
(princ "\n2. 当前Emacs配置:\n")
(if epg-gpg-program
(progn
(princ (format " Using path: %s\n" epg-gpg-program))
(condition-case err
(let ((version (shell-command-to-string (format "\"%s\" --version" epg-gpg-program))))
(princ (format " Version: %s" (car (split-string version "\n")))))
(error (princ (format " Warning: version check failed: %s\n" (error-message-string err))))))
(princ " ✗ epg-gpg-program 未设置\n"))
(princ (format " epa-pinentry-mode: %s\n" epa-pinentry-mode))
;; Mastodon相关设置
(princ "\n3. Mastodon配置:\n")
(if (boundp 'mastodon-client-file-encryption)
(princ (format " Encryption setting: %s\n"
(if mastodon-client-file-encryption "GPG加密" "明文存储（当前设置）")))
(princ " ✓ 加密设置: 默认（依赖GPG）\n"))
;; 给出建议
(princ "\n=== 状态总结 ===\n")
(cond
((not (boundp 'mastodon-client-file-encryption))
(princ "⚠️ Mastodon包未加载，无法确定加密设置\n"))
((not mastodon-client-file-encryption)
(princ "OK: Mastodon configured for plaintext storage, should work normally\n")
(princ " For GPG encryption, run M-x my/test-gpg-basic to diagnose issues\n"))
((and epg-gpg-program (file-exists-p epg-gpg-program))
(princ "OK: GPG configured, mastodon should work with encryption\n"))
(found-paths
(princ "Warning: Found GPG but not properly configured, please restart Emacs\n"))
(t
(princ "Error: GPG not found, suggest enabling plaintext storage\n"))))
(princ "\nRun M-x my/setup-gpg to reconfigure GPG\n")))
(defun my/test-gpg-basic ()
"Test basic GPG functionality to help troubleshoot issues."
(interactive)
(with-output-to-temp-buffer "*GPG Basic Test*"
(princ "=== GPG Basic Functionality Test ===\n\n")
;; 测试GPG版本
(princ "1. GPG Version Test:\n")
(condition-case err
(let ((version-output (shell-command-to-string (format "\"%s\" --version" epg-gpg-program))))
(princ (format " Version info:\n%s\n" version-output)))
(error (princ (format " Error: Version check failed: %s\n" (error-message-string err)))))
;; 测试密钥列表
(princ "2. Key Check:\n")
(condition-case err
(let ((keys-output (shell-command-to-string (format "\"%s\" --list-keys" epg-gpg-program))))
(if (string-match "gpg: error" keys-output)
(princ " Warning: Key list has warnings, but this is usually normal\n")
(princ " Key list access normal\n")))
(error (princ (format " Error: Key check failed: %s\n" (error-message-string err)))))
;; 测试Emacs EPA
(princ "3. Emacs EPA Test:\n")
(condition-case err
(progn
(require 'epg)
(let ((context (epg-make-context)))
(princ " EPA context created successfully\n")))
(error (princ (format " Error: EPA test failed: %s\n" (error-message-string err)))))
;; 给出建议
(princ "\n=== Suggestions ===\n")
(princ "If GPG basic functionality works but mastodon still has issues:\n")
(princ "1. Plaintext storage is currently enabled, mastodon should work normally\n")
(princ "2. For full GPG support, you may need to generate GPG keypair\n")
(princ "3. Run: gpg --full-generate-key (in command line)\n")
(princ "4. Or continue using plaintext storage (usually secure enough for personal use)\n")))
(provide 'pkg-social)
;;; pkg-social.el ends here